Diff
Not logged in

Differences From Artifact [fe3dc2588c]:

To Artifact [3e61060b0b]:


361
362
363
364
365
366
367
368

369
370
371
372
373
374
375
361
362
363
364
365
366
367

368
369
370
371
372
373
374
375







-
+







    PREC_EQUAL,		/* NOT_IN_LIST */
    PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
    PREC_END,		/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  
    0,
    /* Unary operator lexemes */
    PREC_UNARY,		/* UNARY_PLUS */
    PREC_UNARY,		/* UNARY_MINUS */
    PREC_UNARY,		/* FUNCTION */
    PREC_START,		/* START */
    PREC_OPEN_PAREN,	/* OPEN_PAREN */
    PREC_UNARY,		/* NOT*/
416
417
418
419
420
421
422
423

424
425
426
427
428
429
430
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430







-
+







    INST_LIST_NOT_IN,	/* NOT_IN_LIST */
    0,			/* CLOSE_PAREN */
    0,			/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  
    0,
    /* Unary operator lexemes */
    INST_UPLUS,		/* UNARY_PLUS */
    INST_UMINUS,	/* UNARY_MINUS */
    0,			/* FUNCTION */
    0,			/* START */
    0,			/* OPEN_PAREN */
    INST_LNOT,		/* NOT*/
484
485
486
487
488
489
490
491

492
493
494
495
496
497
498
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498







-
+







 * TclEmitForwardJump() and TclFixupForwardJump() calls that are performed
 * when compiling the short-circuiting operators QUESTION/COLON, AND, and OR.
 * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
 */

typedef struct JumpList {
    JumpFixup jump;		/* Pass this argument to matching calls of
				 * TclEmitForwardJump() and 
				 * TclEmitForwardJump() and
				 * TclFixupForwardJump(). */
    struct JumpList *next;	/* Point to next item on the stack */
} JumpList;

/*
 * Declarations for local functions to this file:
 */
834
835
836
837
838
839
840
841

842
843
844
845
846
847
848
834
835
836
837
838
839
840

841
842
843
844
845
846
847
848







-
+







		    Tcl_DecrRefCount(literal);
		}
		goto error;
	    }

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN: 
	    case BOOLEAN:
		/*
		 * TODO: Consider using a dict or hash to collapse all
		 * duplicate literals into a single representative value.
		 * (Like what is done with [split $s {}]).
		 * Pro:	~75% memory saving on expressions like
		 *	{1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
		 *	to "pointer" cost only)
857
858
859
860
861
862
863
864

865
866
867
868
869
870
871
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871







-
+







		 */

		Tcl_ListObjAppendElement(NULL, litList, literal);
		complete = lastParsed = OT_LITERAL;
		start += scanned;
		numBytes -= scanned;
		continue;
	    

	    default:
		break;
	    }

	    /*
	     * Remaining LEAF cases may involve filling Tcl_Tokens, so make
	     * room for at least 2 more tokens.
1320
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334
1320
1321
1322
1323
1324
1325
1326

1327
1328
1329
1330
1331
1332
1333
1334







-
+







	     */

	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->mark = MARK_LEFT;
	    nodePtr->left = complete;

	    /* 
	    /*
	     * The COMMA operator cannot be optimized, since the function
	     * needs all of its arguments, and optimization would reduce the
	     * number. Other binary operators root constant expressions when
	     * both arguments are constant expressions.
	     */

	    nodePtr->constant = (lexeme != COMMA);
1542
1543
1544
1545
1546
1547
1548
1549

1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565

1566
1567
1568
1569
1570
1571
1572
1542
1543
1544
1545
1546
1547
1548

1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564

1565
1566
1567
1568
1569
1570
1571
1572







-
+















-
+







	     * word has multiple elements, a TCL_TOKEN_WORD token is kept as a
	     * grouping device so that TCL_TOKEN_SUB_EXPR always has only one
	     * element. Wise or not, these are the rules the Tcl expr parser
	     * has followed, and for the sake of those few callers of
	     * Tcl_ParseExpr() we do not change them now. Internally, we can
	     * do better.
	     */
	

	    int toCopy = tokenPtr->numComponents + 1;

	    if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
		/*
		 * Single element word. Copy tokens and convert the leading
		 * token to TCL_TOKEN_SUB_EXPR.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		memcpy(subExprTokenPtr, tokenPtr,
			(size_t) toCopy * sizeof(Tcl_Token));
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		parsePtr->numTokens += toCopy;
	    } else {
		/* 
		/*
		 * Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
		 * lead, with fields initialized from the leading token, then
		 * copy entire set of word tokens.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy+1);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
1607
1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1621







-
+







	     */

	    switch (nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/* 
		/*
		 * Historical practice has been to have no Tcl_Tokens for
		 * these operators.
		 */

		break;

	    default: {
1743
1744
1745
1746
1747
1748
1749
1750

1751
1752
1753
1754
1755
1756
1757
1743
1744
1745
1746
1747
1748
1749

1750
1751
1752
1753
1754
1755
1756
1757







-
+







		break;

	    default:

		/*
		 * Before we leave this node/operator/subexpression for the
		 * last time, finish up its tokens....
		 * 
		 *
		 * Our current position scanning the string is where the
		 * substring for the subexpression ends.
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;

1963
1964
1965
1966
1967
1968
1969
1970

1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984

1985
1986
1987
1988
1989
1990
1991


1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006

2007
2008

2009
2010
2011
2012
2013
2014
2015
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983

1984
1985
1986
1987
1988
1989
1990

1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006

2007


2008
2009
2010
2011
2012
2013
2014
2015







-
+













-
+






-
+
+














-
+
-
-
+







	    }
	}
	*lexemePtr = GREATER;
	return 1;

    case 'i':
	if ((numBytes > 1) && (start[1] == 'n')
		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
	    /*
	     * Must make this check so we can tell the difference between the
	     * "in" operator and the "int" function name and the "infinity"
	     * numeric value.
	     */

	    *lexemePtr = IN_LIST;
	    return 2;
	}
	break;

    case 'e':
	if ((numBytes > 1) && (start[1] == 'q')
		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
	    *lexemePtr = STREQ;
	    return 2;
	}
	break;

    case 'n':
	if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
	if ((numBytes > 1)
		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
	    switch (start[1]) {
	    case 'e':
		*lexemePtr = STRNEQ;
		return 2;
	    case 'i':
		*lexemePtr = NOT_IN_LIST;
		return 2;
	    }
	}
    }

    literal = Tcl_NewObj();
    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	if (end < start + numBytes && !isalnum(UCHAR(*end))
	if (end < start + numBytes && !TclIsBareword(*end)) {
		&& UCHAR(*end) != '_') {
	

	number:
	    TclInitStringRep(literal, start, end-start);
	    *lexemePtr = NUMBER;
	    if (literalPtr) {
		*literalPtr = literal;
	    } else {
		Tcl_DecrRefCount(literal);
2025
2026
2027
2028
2029
2030
2031
2032

2033
2034

2035
2036
2037
2038
2039
2040
2041
2025
2026
2027
2028
2029
2030
2031

2032
2033

2034
2035
2036
2037
2038
2039
2040
2041







-
+

-
+







	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (literal->typePtr == &tclDoubleType) {
		const char *p = start;

		while (p < end) {
		    if (!isalnum(UCHAR(*p++))) {
		    if (!TclIsBareword(*p++)) {
			/*
			 * The number has non-bareword characters, so we 
			 * The number has non-bareword characters, so we
			 * must treat it as a number.
			 */
			goto number;
		    }
		}
	    }
	    ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
2050
2051
2052
2053
2054
2055
2056







2057
2058
2059
2060




2061
2062
2063
2064
2065




2066
2067
2068
2069
2070
2071
2072
2073
2074



2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101

2102
2103
2104
2105
2106
2107
2108
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063




2064
2065
2066
2067
2068




2069
2070
2071
2072

2073
2074
2075
2076
2077



2078
2079
2080









2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097

2098
2099
2100
2101
2102
2103
2104
2105







+
+
+
+
+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
-





-
-
-
+
+
+
-
-
-
-
-
-
-
-
-

















-
+








	    /*
	     * Otherwise, fall through and parse the whole as a bareword.
	     */
	}
    }

    /*
     * We reject leading underscores in bareword.  No sensible reason why.
     * Might be inspired by reserved identifier rules in C, which of course
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {
    if (Tcl_UtfCharComplete(start, numBytes)) {
	scanned = Tcl_UtfToUniChar(start, &ch);
    } else {
	char utfBytes[TCL_UTF_MAX];
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = Tcl_UtfToUniChar(start, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];

	memcpy(utfBytes, start, (size_t) numBytes);
	utfBytes[numBytes] = '\0';
	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
    }
	    memcpy(utfBytes, start, (size_t) numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
	}
    if (!isalnum(UCHAR(ch))) {
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
	end += scanned;
	numBytes -= scanned;
    while (numBytes && TclIsBareword(*end)) {
	end += 1;
	numBytes -= 1;
	if (Tcl_UtfCharComplete(end, numBytes)) {
	    scanned = Tcl_UtfToUniChar(end, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, end, (size_t) numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
	}
    }
    *lexemePtr = BAREWORD;
    if (literalPtr) {
	Tcl_SetStringObj(literal, start, (int) (end-start));
	*literalPtr = literal;
    } else {
	Tcl_DecrRefCount(literal);
    }
    return (end-start);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExpr --
 *
 *	This procedure compiles a string containing a Tcl expression into Tcl
 *	bytecodes. 
 *	bytecodes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *
2329
2330
2331
2332
2333
2334
2335
2336

2337
2338
2339
2340
2341
2342
2343
2326
2327
2328
2329
2330
2331
2332

2333
2334
2335
2336
2337
2338
2339
2340







-
+







		/* do nothing */
		break;
	    case FUNCTION:
		/*
		 * Use the numWords count we've kept to invoke the function
		 * command with the correct number of arguments.
		 */
		

		if (numWords < 255) {
		    TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
		} else {
		    TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
		}

		/*
2423
2424
2425
2426
2427
2428
2429
2430

2431
2432
2433
2434
2435
2436
2437
2420
2421
2422
2423
2424
2425
2426

2427
2428
2429
2430
2431
2432
2433
2434







-
+







	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int index = TclRegisterNewLiteral(envPtr, bytes, length);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
		

		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
		     * Tcl_IncrRefCount(literal);
		     * Tcl_DecrRefCount(objPtr);
2566
2567
2568
2569
2570
2571
2572
2573

2574
2575
2576
2577
2578
2579
2580
2563
2564
2565
2566
2567
2568
2569

2570
2571
2572
2573
2574
2575
2576
2577







-
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclSortingOpCmd --
 *	Implements the commands:
 *		<, <=, >, >=, ==, eq 
 *		<, <=, >, >=, ==, eq
 *	in the ::tcl::mathop namespace. These commands are defined for
 *	arbitrary number of arguments by computing the AND of the base
 *	operator applied to all neighbor argument pairs.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *