summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-07-17 19:18:53 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-07-17 19:18:53 (GMT)
commitd37e9449abbcba6add40d5796795b556541402c3 (patch)
treea96444038993c3d62d4657ff661f62eff036ddb6
parent6122754a220a2b6625224214b2560b4c3f594e4b (diff)
downloadtcl-d37e9449abbcba6add40d5796795b556541402c3.zip
tcl-d37e9449abbcba6add40d5796795b556541402c3.tar.gz
tcl-d37e9449abbcba6add40d5796795b556541402c3.tar.bz2
* generic/tclCompExpr.c (ParseExpr): While adding comments to
explain the operations of ParseExpr(), made significant revisions to the code so it would be easier to explain, and in the process made the code simpler and clearer as well.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCompExpr.c453
2 files changed, 258 insertions, 202 deletions
diff --git a/ChangeLog b/ChangeLog
index 7057eb3..6eb60e7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-07-17 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c (ParseExpr): While adding comments to
+ explain the operations of ParseExpr(), made significant revisions
+ to the code so it would be easier to explain, and in the process
+ made the code simpler and clearer as well.
+
2007-07-15 Don Porter <dgp@users.sourceforge.net>
* generic/tclCompExpr.c: More commentary.
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index bab56f5..3304b51 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.69 2007/07/16 19:50:46 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.70 2007/07/17 19:18:54 dgp Exp $
*/
#include "tclInt.h"
@@ -29,7 +29,10 @@
typedef struct OpNode {
int left; /* "Pointer" to the left operand. */
int right; /* "Pointer" to the right operand. */
- int parent; /* "Pointer" to the parent operand. */
+ union {
+ int parent; /* "Pointer" to the parent operand. */
+ int prev; /* "Pointer" joining incomplete tree stack */
+ } p;
unsigned char lexeme; /* Code that identifies the operator. */
unsigned char precedence; /* Precedence of the operator */
} OpNode;
@@ -83,12 +86,17 @@ enum OperandTypes {
* the inorder traversals of the completed tree we perform are known to visit
* the leaves in the same order as the original parse.
*
- * Those OpNodes that are themselves (roots of subexpression trees that are)
- * operands of some operator store in their parent field a "pointer" to the
- * OpNode of that operator. The parent field permits a destructive inorder
- * traversal of the tree within a non-recursive routine (ConvertTreeToTokens()
- * and CompileExprTree()). This means that even expression trees of great
- * depth pose no risk of blowing the C stack.
+ * In a completed parse tree, those OpNodes that are themselves (roots of
+ * subexpression trees that are) operands of some operator store in their
+ * p.parent field a "pointer" to the OpNode of that operator. The p.parent
+ * field permits a destructive inorder traversal of the tree within a
+ * non-recursive routine (ConvertTreeToTokens() and CompileExprTree()). This
+ * means that even expression trees of great depth pose no risk of blowing
+ * the C stack.
+ *
+ * While the parse tree is being constructed, the same memory space is used
+ * to hold the p.prev field which chains together a stack of incomplete
+ * trees awaiting their right operands.
*
* The lexeme field is filled in with the lexeme of the operator that is
* returned by the ParseLexeme() routine. Only lexemes for unary and
@@ -458,22 +466,27 @@ ParseExpr(
* for most expressions to parse with no need
* for array growth and reallocation. */
int nodesUsed = 0; /* Number of OpNodes filled. */
- int code = TCL_OK; /* Return code */
int scanned = 0; /* Capture number of byte scanned by
* parsing routines. */
- unsigned char lexeme = START; /* Most recent lexeme parsed. */
- int lastOpen = 0; /* Index of the OpNode of the OPEN_PAREN
- * operator we most recently matched. */
- int lastParsed = 0; /* Stores info about what the lexeme parsed
+ unsigned char lexeme; /* Most recent lexeme parsed. */
+ int lastParsed; /* Stores info about what the lexeme parsed
* the previous pass through the parsing loop
* was. If it was an operator, lastParsed is
* the index of the OpNode for that operator.
- * If it was not and operator, lastParsed holds
+ * If it was not an operator, lastParsed holds
* an OperandTypes value encoding what we
- * need to know about it. The initial value
- * is 0 indicating that as we start the "last
- * thing we parsed" was the START lexeme stored
- * in node 0. */
+ * need to know about it. */
+ int incomplete; /* Index of the most recent incomplete tree
+ * in the OpNode array. Heads a stack of
+ * incomplete trees linked by p.prev. */
+ int complete = OT_NONE; /* "Index" of the complete tree (that is, a
+ * complete subexpression) determined at the
+ * moment. OT_NONE is a nonsense value
+ * used only to silence compiler warnings.
+ * During a parse, complete will always hold
+ * an index or an OperandTypes value pointing
+ * to an actual leaf at the time the complete
+ * tree is needed. */
/* These variables control generation of the error message. */
Tcl_Obj *msg = NULL; /* The error message. */
@@ -504,22 +517,25 @@ ParseExpr(
nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
if (nodes == NULL) {
TclNewLiteralStringObj(msg, "not enough memory to parse expression");
- code = TCL_ERROR;
- } else {
- /*
- * Initialize the parse tree with the special "START" node.
- */
-
- nodes->lexeme = lexeme;
- nodes->precedence = prec[lexeme];
- nodes->left = OT_NONE;
- nodes->right = OT_NONE;
- /* TODO: explain. */
- nodes->parent = -1;
- nodesUsed++;
+ goto error;
}
- while ((code == TCL_OK) && (lexeme != END)) {
+ /* Initialize the parse tree with the special "START" node. */
+ nodes->lexeme = START;
+ nodes->precedence = prec[START];
+ nodes->left = OT_NONE;
+ nodes->right = OT_NONE;
+ incomplete = lastParsed = nodesUsed;
+ nodesUsed++;
+
+ /*
+ * Main parsing loop parses one lexeme per iteration. We exit the
+ * loop only when there's a syntax error with a "goto error" which
+ * takes us to the error handling code following the loop, or when
+ * we've successfully complete the parse and we return to the caller.
+ */
+
+ while (1) {
OpNode *nodePtr; /* Points to the OpNode we may fill this
* pass through the loop. */
Tcl_Obj *literal; /* Filled by the ParseLexeme() call when
@@ -549,47 +565,40 @@ ParseExpr(
if (newPtr == NULL) {
TclNewLiteralStringObj(msg,
"not enough memory to parse expression");
- code = TCL_ERROR;
- continue;
+ goto error;
}
nodesAvailable = size;
nodes = newPtr;
}
nodePtr = nodes + nodesUsed;
- /*
- * Skip white space between lexemes.
- */
-
+ /* Skip white space between lexemes. */
scanned = TclParseAllWhiteSpace(start, numBytes);
start += scanned;
numBytes -= scanned;
scanned = ParseLexeme(start, numBytes, &lexeme, &literal);
- /*
- * Use context to categorize the lexemes that are ambiguous.
- */
-
+ /* Use context to categorize the lexemes that are ambiguous. */
if ((NODE_TYPE & lexeme) == 0) {
switch (lexeme) {
case INVALID:
msg = Tcl_ObjPrintf(
"invalid character \"%.*s\"", scanned, start);
- code = TCL_ERROR;
- continue;
+ goto error;
case INCOMPLETE:
msg = Tcl_ObjPrintf(
"incomplete operator \"%.*s\"", scanned, start);
- code = TCL_ERROR;
- continue;
+ goto error;
case BAREWORD:
+
/*
* Most barewords in an expression are a syntax error.
* The exceptions are that when a bareword is followed by
* an open paren, it might be a function call, and when the
* bareword is a legal literal boolean value, we accept that
* as well.
+
*/
if (start[scanned+TclParseAllWhiteSpace(
start+scanned, numBytes-scanned)] == '(') {
@@ -601,6 +610,7 @@ ParseExpr(
* 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 {
int b;
@@ -622,18 +632,19 @@ ParseExpr(
" or \"%.*s%s(...)\" or ...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
- code = TCL_ERROR;
- continue;
+ goto error;
}
}
break;
case PLUS:
case MINUS:
if (IsOperator(lastParsed)) {
+
/*
* A "+" or "-" coming just after another operator
* must be interpreted as a unary operator.
*/
+
lexeme |= UNARY;
} else {
lexeme |= BINARY;
@@ -641,10 +652,7 @@ ParseExpr(
}
} /* Uncategorized lexemes */
- /*
- * Handle lexeme based on its category.
- */
-
+ /* Handle lexeme based on its category. */
switch (NODE_TYPE & lexeme) {
/*
@@ -658,6 +666,7 @@ ParseExpr(
Tcl_Token *tokenPtr;
const char *end = start;
int wordIndex;
+ int code = TCL_OK;
/*
* A leaf operand appearing just after something that's not an
@@ -678,19 +687,19 @@ ParseExpr(
scanned = 0;
insertMark = 1;
parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
- code = TCL_ERROR;
- /*
- * Delay our escape from the parse loop until any literal
- * can be appended to litList, making it available to our
- * caller to be freed, to avoid leaking it.
- */
+
+ /* Free any literal to avoid a memleak. */
+ if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
+ Tcl_DecrRefCount(literal);
+ }
+ goto error;
}
switch (lexeme) {
case NUMBER:
case BOOLEAN:
Tcl_ListObjAppendElement(NULL, litList, literal);
- lastParsed = OT_LITERAL;
+ complete = lastParsed = OT_LITERAL;
start += scanned;
numBytes -= scanned;
continue;
@@ -698,11 +707,6 @@ ParseExpr(
break;
}
- if (code != TCL_OK) {
- /* Escaping the loop due to syntax error is fine now. */
- continue;
- }
-
/*
* Remaining LEAF cases may involve filling Tcl_Tokens, so
* make room for at least 2 more tokens.
@@ -741,8 +745,7 @@ ParseExpr(
tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
TclNewLiteralStringObj(msg, "invalid character \"$\"");
- code = TCL_ERROR;
- continue;
+ goto error;
}
scanned = tokenPtr->size;
break;
@@ -793,6 +796,7 @@ ParseExpr(
}
}
if (code != TCL_OK) {
+
/*
* Here we handle all the syntax errors generated by
* the Tcl_Token generating parsing routines called in the
@@ -808,10 +812,10 @@ ParseExpr(
* the syntax error is sure to appear in it, even if the
* quoted expression is truncated.
*/
+
start = parsePtr->term;
scanned = parsePtr->incomplete;
- /* Escape the parse loop to report the syntax error. */
- continue;
+ goto error;
}
tokenPtr = parsePtr->tokenPtr + wordIndex;
@@ -839,52 +843,55 @@ ParseExpr(
literal = Tcl_NewObj();
if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
Tcl_ListObjAppendElement(NULL, litList, literal);
- lastParsed = OT_LITERAL;
+ complete = lastParsed = OT_LITERAL;
parsePtr->numTokens = wordIndex;
break;
}
Tcl_DecrRefCount(literal);
}
- lastParsed = OT_TOKENS;
+ complete = lastParsed = OT_TOKENS;
break;
} /* case LEAF */
case UNARY:
+
/*
* A unary operator appearing just after something that's not an
* operator is a syntax error -- something trying to be the left
* operand of an operator that doesn't take one.
*/
+
if (NotOperator(lastParsed)) {
msg = Tcl_ObjPrintf("missing operator at %s", mark);
scanned = 0;
insertMark = 1;
- code = TCL_ERROR;
- /* Escape the parse loop to report the syntax error. */
- continue;
+ goto error;
}
+
/* Create an OpNode for the unary operator */
nodePtr->lexeme = lexeme; /* Remember the operator... */
nodePtr->precedence = prec[lexeme]; /* ... and its precedence. */
nodePtr->left = OT_NONE; /* No left operand */
nodePtr->right = OT_NONE; /* Right operand not
* yet known. */
- /* TODO: explain */
- nodePtr->parent = nodePtr - nodes - 1;
+
/*
- * Remember this unary operator as the last thing parsed for
- * the next pass through the loop.
+ * This unary operator is a new incomplete tree, so push it
+ * onto our stack of incomplete trees. Also remember it as
+ * the last lexeme we parsed.
*/
- lastParsed = nodesUsed;
+
+ nodePtr->p.prev = incomplete;
+ incomplete = lastParsed = nodesUsed;
nodesUsed++;
break;
case BINARY: {
- OpNode *otherPtr = NULL;
+ OpNode *incompletePtr;
unsigned char precedence = prec[lexeme];
/*
- * A binary operand appearing just after another operator is a
+ * A binary operator appearing just after another operator is a
* syntax error -- one of the two operators is missing an operand.
*/
@@ -892,22 +899,28 @@ ParseExpr(
if ((lexeme == CLOSE_PAREN)
&& (nodePtr[-1].lexeme == OPEN_PAREN)) {
if (nodePtr[-2].lexeme == FUNCTION) {
+
/*
* Normally, "()" is a syntax error, but as a special
* case accept it as an argument list for a function.
+ * Treat this as a special LEAF lexeme, and restart
+ * the parsing loop with zero characters scanned.
+ * We'll parse the ")" again the next time through,
+ * but with the OT_EMPTY leaf as the subexpression
+ * between the parens.
*/
scanned = 0;
+ complete = lastParsed = OT_EMPTY;
+
/* TODO: explain */
- lastParsed = OT_EMPTY;
nodePtr[-1].left--;
break;
}
msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
scanned = 0;
insertMark = 1;
- code = TCL_ERROR;
- continue;
+ goto error;
}
if (nodePtr[-1].precedence > precedence) {
@@ -939,199 +952,240 @@ ParseExpr(
scanned = 0;
insertMark = 1;
}
- code = TCL_ERROR;
- continue;
+ goto error;
}
- /* TODO: explain */
- if (lastParsed == OT_NONE) {
- otherPtr = nodes + lastOpen - 1;
- lastParsed = lastOpen;
- } else {
- otherPtr = nodePtr - 1;
- }
+ /*
+ * Here is where the tree comes together. At this point, we
+ * have a sequence of incomplete trees corresponding to
+ * substrings that are incomplete expressions, followed by
+ * a complete tree corresponding to a substring that is itself
+ * a complete expression, followed by the binary operator we have
+ * just parsed. The incomplete trees can each be completed by
+ * adding a right operand.
+ *
+ * To illustrate with an example, when we parse the expression
+ * "1+2*3-4" and we reach this point having just parsed the "-"
+ * operator, we have these incomplete trees: START, "1+", and
+ * "2*". Next we have the complete subexpression "3". Last is
+ * the "-" we've just parsed.
+ *
+ * The next step is to join our complete tree to an operator.
+ * The choice is governed by the precedence and associativity
+ * of the competing operators. If we connect it as the right
+ * operand of our most recent incomplete tree, we get a new
+ * complete tree, and we can repeat the process. The while
+ * loop following repeats this until precedence indicates it
+ * is time to join the complete tree as the left operand of
+ * the just parsed binary operator.
+ *
+ * Continuing the example, the first pass through the loop
+ * will join "3" to "2*"; the next pass will join "2*3" to
+ * "1+". Then we'll exit the loop and join "1+2*3" to "-".
+ * When we return to parse another lexeme, our incomplete
+ * tree list is START and "1+2*3-".
+ */
+
while (1) {
- /*
- * lastParsed is "index" of item to be linked.
- * otherPtr points to competing operator.
- */
+ incompletePtr = nodes + incomplete;
- if (otherPtr->precedence < precedence) {
+ if (incompletePtr->precedence < precedence) {
break;
}
- if (otherPtr->precedence == precedence) {
- /*
- * Right association rules for exponentiation.
- */
+ if (incompletePtr->precedence == precedence) {
+ /* Right association rules for exponentiation. */
if (lexeme == EXPON) {
break;
}
/*
- * Special association rules for the ternary operators.
+ * Special association rules for the conditional operators.
* The "?" and ":" operators have equal precedence, but
* must be linked up in sensible pairs.
*/
- if ((otherPtr->lexeme == QUESTION)
- && (NotOperator(lastParsed)
- || (nodes[lastParsed].lexeme != COLON))) {
+ if ((incompletePtr->lexeme == QUESTION)
+ && (NotOperator(complete)
+ || (nodes[complete].lexeme != COLON))) {
break;
}
- if ((otherPtr->lexeme == COLON) && (lexeme == QUESTION)) {
+ if ((incompletePtr->lexeme == COLON)
+ && (lexeme == QUESTION)) {
break;
}
}
- /*
- * We should link the lastParsed item to the otherPtr as its
- * right operand. First make some syntax checks.
- */
+ /* Some special syntax checks... */
- if ((otherPtr->lexeme == OPEN_PAREN)
+ /* Parens must balance */
+ if ((incompletePtr->lexeme == OPEN_PAREN)
&& (lexeme != CLOSE_PAREN)) {
TclNewLiteralStringObj(msg, "unbalanced open paren");
parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
- code = TCL_ERROR;
- break;
+ goto error;
}
- if ((otherPtr->lexeme == QUESTION)
- && (NotOperator(lastParsed)
- || (nodes[lastParsed].lexeme != COLON))) {
+
+ /* Right operand of "?" must be ":" */
+ if ((incompletePtr->lexeme == QUESTION)
+ && (NotOperator(complete)
+ || (nodes[complete].lexeme != COLON))) {
msg = Tcl_ObjPrintf(
"missing operator \":\" at %s", mark);
scanned = 0;
insertMark = 1;
- code = TCL_ERROR;
- break;
+ goto error;
}
- if (IsOperator(lastParsed)
- && (nodes[lastParsed].lexeme == COLON)
- && (otherPtr->lexeme != QUESTION)) {
+
+ /* Operator ":" may only be right operand of "?" */
+ if (IsOperator(complete)
+ && (nodes[complete].lexeme == COLON)
+ && (incompletePtr->lexeme != QUESTION)) {
TclNewLiteralStringObj(msg,
- "unexpected operator \":\" without preceding \"?\"");
- code = TCL_ERROR;
- break;
+ "unexpected operator \":\" "
+ "without preceding \"?\"");
+ goto error;
}
/*
- * Link orphan as right operand of otherPtr.
+ * Attach complete tree as right operand of most recent
+ * incomplete tree.
*/
- otherPtr->right = lastParsed;
- if (lastParsed >= 0) {
- nodes[lastParsed].parent = otherPtr - nodes;
+ incompletePtr->right = complete;
+ if (IsOperator(complete)) {
+ nodes[complete].p.parent = incomplete;
}
- lastParsed = otherPtr - nodes;
- if (otherPtr->lexeme == OPEN_PAREN) {
+ if (incompletePtr->lexeme == START) {
+
/*
- * CLOSE_PAREN can only close one OPEN_PAREN.
+ * Completing the START tree indicates we're done.
+ * Transfer the parse tree to the caller and return.
*/
- break;
+ *opTreePtr = nodes;
+ return TCL_OK;
}
- if (otherPtr->lexeme == START) {
- /*
- * Don't backtrack beyond the start.
- */
+ /*
+ * With a right operand attached, last incomplete tree has
+ * become the complete tree. Pop it from the incomplete
+ * tree stack.
+ */
+ complete = incomplete;
+ incomplete = incompletePtr->p.prev;
+
+ /* CLOSE_PAREN can only close one OPEN_PAREN. */
+ if (incompletePtr->lexeme == OPEN_PAREN) {
break;
}
- otherPtr = nodes + otherPtr->parent;
- }
- if (code != TCL_OK) {
- continue;
}
+ /* More syntax checks... */
+
+ /* Parens must balance. */
if (lexeme == CLOSE_PAREN) {
- if (otherPtr->lexeme == START) {
+ if (incompletePtr->lexeme != OPEN_PAREN) {
TclNewLiteralStringObj(msg, "unbalanced close paren");
- code = TCL_ERROR;
- continue;
+ goto error;
}
- lastParsed = OT_NONE;
- lastOpen = otherPtr - nodes;
- otherPtr->left++;
-
- /*
- * Create no node for a CLOSE_PAREN lexeme.
- */
-
- break;
}
+
+ /* Commas must appear only in function argument lists. */
if (lexeme == COMMA) {
- if ((otherPtr->lexeme != OPEN_PAREN)
- || (otherPtr[-1].lexeme != FUNCTION)) {
+ if ((incompletePtr->lexeme != OPEN_PAREN)
+ || (incompletePtr[-1].lexeme != FUNCTION)) {
TclNewLiteralStringObj(msg,
"unexpected \",\" outside function argument list");
- code = TCL_ERROR;
- continue;
+ goto error;
}
- otherPtr->left++;
+
+ /* TODO: explain */
+ incompletePtr->left++;
}
- if (IsOperator(lastParsed) && (nodes[lastParsed].lexeme == COLON)) {
+
+ /* Operator ":" may only be right operand of "?" */
+ if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
TclNewLiteralStringObj(msg,
"unexpected operator \":\" without preceding \"?\"");
- code = TCL_ERROR;
- continue;
- }
- if (lexeme == END) {
- continue;
+ goto error;
}
- /*
- * Link orphan as left operand of new node.
- */
+ /* Create no node for a CLOSE_PAREN lexeme. */
+ if (lexeme == CLOSE_PAREN) {
+
+ /* TODO: explain */
+ incompletePtr->left++;
+ break;
+ }
+ /* Link complete tree as left operand of new node. */
nodePtr->lexeme = lexeme;
nodePtr->precedence = precedence;
- nodePtr->right = -1;
- nodePtr->left = lastParsed;
- if (lastParsed < 0) {
- nodePtr->parent = nodePtr - nodes - 1;
- } else {
- nodePtr->parent = nodes[lastParsed].parent;
- nodes[lastParsed].parent = nodePtr - nodes;
+ nodePtr->right = OT_NONE;
+ nodePtr->left = complete;
+ if (IsOperator(complete)) {
+ nodes[complete].p.parent = nodesUsed;
}
- lastParsed = nodesUsed;
+
+ /*
+ * With a left operand attached and a right operand missing,
+ * the just-parsed binary operator is root of a new incomplete
+ * tree. Push it onto the stack of incomplete trees.
+ */
+
+ nodePtr->p.prev = incomplete;
+ incomplete = lastParsed = nodesUsed;
nodesUsed++;
break;
} /* case BINARY */
} /* lexeme handler */
/* Advance past the just-parsed lexeme */
-
start += scanned;
numBytes -= scanned;
} /* main parsing loop */
- /* In case of any error, we free any partial parse tree we've built. */
- if (code != TCL_OK && nodes != NULL) {
+ error:
+
+ /*
+ * We only get here if there's been an error.
+ * Any errors that didn't get a suitable parsePtr->errorType,
+ * get recorded as syntax errors.
+ */
+
+ if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
+ parsePtr->errorType = TCL_PARSE_SYNTAX;
+ }
+
+ /* Free any partial parse tree we've built. */
+ if (nodes != NULL) {
ckfree((char*) nodes);
}
- if (code == TCL_OK) {
- /* No error, transfer the parse tree to the caller */
- *opTreePtr = nodes;
- } else if (interp == NULL) {
+
+ if (interp == NULL) {
/* Nowhere to report an error message, so just free it */
if (msg) {
Tcl_DecrRefCount(msg);
}
} else {
+
/*
* Construct the complete error message. Start with the simple
* error message, pulled from the interp result if necessary...
*/
+
if (msg == NULL) {
msg = Tcl_GetObjResult(interp);
}
+
/*
* Add a detailed quote from the bad expression, displaying and
* sometimes marking the precise location of the syntax error.
*/
+
Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
((start - limit) < parsePtr->string) ? "" : "...",
((start - limit) < parsePtr->string)
@@ -1144,6 +1198,7 @@ ParseExpr(
? parsePtr->end - (start + scanned) : limit-3,
start + scanned,
(start + scanned + limit > parsePtr->end) ? "" : "...");
+
/* Next, append any postscript message. */
if (post != NULL) {
Tcl_AppendToObj(msg, ";\n", -1);
@@ -1151,6 +1206,7 @@ ParseExpr(
Tcl_DecrRefCount(post);
}
Tcl_SetObjResult(interp, msg);
+
/* Finally, place context information in the errorInfo. */
numBytes = parsePtr->end - parsePtr->string;
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
@@ -1159,14 +1215,7 @@ ParseExpr(
parsePtr->string, (numBytes < limit) ? "" : "..."));
}
- /*
- * Any errors that didn't get a suitable parsePtr->errorType,
- * get recorded as syntax errors.
- */
- if (code != TCL_OK && parsePtr->errorType == TCL_PARSE_SUCCESS) {
- parsePtr->errorType = TCL_PARSE_SYNTAX;
- }
- return code;
+ return TCL_ERROR;
}
/*
@@ -1385,7 +1434,7 @@ ConvertTreeToTokens(
destPtr->size = start - destPtr->start;
destPtr->numComponents = parsePtr->numTokens - tokenIdx - 1;
}
- nodePtr = nodes + nodePtr->parent;
+ nodePtr = nodes + nodePtr->p.parent;
}
break;
case BINARY:
@@ -1473,7 +1522,7 @@ ConvertTreeToTokens(
destPtr->size = start - destPtr->start;
destPtr->numComponents = parsePtr->numTokens-tokenIdx-1;
}
- nodePtr = nodes + nodePtr->parent;
+ nodePtr = nodes + nodePtr->p.parent;
}
break;
}
@@ -1983,7 +2032,7 @@ CompileExprTree(
TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
*convertPtr = 0;
}
- nodePtr = nodes + nodePtr->parent;
+ nodePtr = nodes + nodePtr->p.parent;
}
break;
case BINARY:
@@ -2128,7 +2177,7 @@ CompileExprTree(
jumpPtr = jumpPtr->next;
TclStackFree(interp, freePtr);
}
- nodePtr = nodes + nodePtr->parent;
+ nodePtr = nodes + nodePtr->p.parent;
}
break;
}
@@ -2188,7 +2237,7 @@ TclSingleOpCmd(
nodes[1].lexeme = lexeme;
nodes[1].left = OT_LITERAL;
nodes[1].right = OT_LITERAL;
- nodes[1].parent = 0;
+ nodes[1].p.parent = 0;
return OpCmd(interp, nodes, objv+1);
}
@@ -2227,10 +2276,10 @@ TclSortingOpCmd(
litObjv[2*(i-1)] = objv[i];
nodes[2*(i-1)].lexeme = AND;
nodes[2*(i-1)].left = lastAnd;
- nodes[lastAnd].parent = 2*(i-1);
+ nodes[lastAnd].p.parent = 2*(i-1);
nodes[2*(i-1)].right = 2*(i-1)+1;
- nodes[2*(i-1)+1].parent= 2*(i-1);
+ nodes[2*(i-1)+1].p.parent= 2*(i-1);
lastAnd = 2*(i-1);
}
@@ -2241,7 +2290,7 @@ TclSortingOpCmd(
nodes[2*(objc-2)-1].right = OT_LITERAL;
nodes[0].right = lastAnd;
- nodes[lastAnd].parent = 0;
+ nodes[lastAnd].p.parent = 0;
code = OpCmd(interp, nodes, litObjv);
@@ -2285,7 +2334,7 @@ TclVariadicOpCmd(
nodes[1].lexeme = lexeme;
nodes[1].left = OT_LITERAL;
nodes[1].right = OT_LITERAL;
- nodes[1].parent = 0;
+ nodes[1].p.parent = 0;
} else {
if (lexeme == DIVIDE) {
litObjv[0] = Tcl_NewDoubleObj(1.0);
@@ -2299,7 +2348,7 @@ TclVariadicOpCmd(
nodes[1].lexeme = lexeme;
nodes[1].left = OT_LITERAL;
nodes[1].right = OT_LITERAL;
- nodes[1].parent = 0;
+ nodes[1].p.parent = 0;
}
code = OpCmd(interp, nodes, litObjv);
@@ -2318,7 +2367,7 @@ TclVariadicOpCmd(
nodes[i].left = OT_LITERAL;
nodes[i].right = lastOp;
if (lastOp >= 0) {
- nodes[lastOp].parent = i;
+ nodes[lastOp].p.parent = i;
}
lastOp = i;
}
@@ -2327,14 +2376,14 @@ TclVariadicOpCmd(
nodes[i].lexeme = lexeme;
nodes[i].left = lastOp;
if (lastOp >= 0) {
- nodes[lastOp].parent = i;
+ nodes[lastOp].p.parent = i;
}
nodes[i].right = OT_LITERAL;
lastOp = i;
}
}
nodes[0].right = lastOp;
- nodes[lastOp].parent = 0;
+ nodes[lastOp].p.parent = 0;
code = OpCmd(interp, nodes, objv+1);