-- ExpressionSyntaxImpl.mesa
-- last edit July 12, 1984 2:24:51 pm PDT Sturgis
DIRECTORY
Ascii USING[Digit, Letter],
Commander USING[CommandProc, Register],
Expressions USING[Expression, ExpressionBody, HCellExpression, HCellIdentifier, Identifier, IdentifierBody, IdTableSetIndex, Operator, Token, TokenBody],
IO USING[CR, PutF, rope, STREAM],
Rope USING[ROPE, Equal, Fetch, Find, FromChar, Length, Substr];
ExpressionSyntaxImpl: PROGRAM IMPORTS Ascii, Commander, IO, Rope EXPORTS Expressions =
BEGIN OPEN Expressions;
ParseCase: TYPE = {gCell, hCell};
StackElement: TYPE = RECORD[
case: StackElementCase,
data: REF ANY];
StackElementCase: TYPE = {expression, operator};
S1, S2, S3, S4, S5, S6: StackElement;
stackRemainder: LIST OF StackElement;
PushStack: PROCEDURE[el: StackElement] =
BEGIN
stackRemainder ← CONS[S6, stackRemainder];
S6 ← S5; S5 ← S4; S4 ← S3; S3 ← S2; S2 ← S1;
S1 ← el;
END;
PopStack: PROCEDURE =
BEGIN
S1 ← S2; S2 ← S3; S3 ← S4; S4 ← S5; S5 ← S6;
S6 ← stackRemainder.first;
stackRemainder ← stackRemainder.rest;
END;
IsOp: PROCEDURE[se: StackElement, op:Operator] RETURNS[BOOLEAN] =
BEGIN
IF se.case # operator THEN RETURN[FALSE];
RETURN[NARROW[se.data, Token].operator = op];
END;
IsExp: PROCEDURE[se: StackElement] RETURNS[BOOLEAN] =
{RETURN[se.case = expression]};
IsIdExp: PROCEDURE[se: StackElement] RETURNS[BOOLEAN] =
BEGIN
exp: Expression;
tkn: Token;
IF se.case = operator THEN RETURN[FALSE];
exp ← NARROW[se.data, Expression];
IF exp.operator # token THEN RETURN[FALSE];
tkn ← NARROW[exp.data1];
RETURN[tkn.operator = id];
END;
AbsorbOneToken: PROCEDURE[t: Token, parseCase: ParseCase] =
BEGIN
SELECT t.operator FROM
number =>
BEGIN
PushStack[[expression, NEW[ExpressionBody ← [token, t]]]];
END;
id =>
BEGIN
t.data ← SELECT parseCase FROM
gCell => ParseGCellIdentifierName[NARROW[t.data]],
hCell => ParseHCellIdentifierName[NARROW[t.data]],
ENDCASE => ERROR;
PushStack[[expression, NEW[ExpressionBody ← [token, t]]]];
END;
plus, minus =>
BEGIN
newOp: Operator;
IF S1.case = operator THEN
BEGIN
token: Token ← NARROW[S1.data];
SELECT token.operator FROM
start, colon, leftParen, if, then, else, assign =>
BEGIN
newOp ← IF t.operator = plus THEN unaryPlus
ELSE unaryMinus;
PushStack[[operator, NEW[TokenBody ← [newOp, t.charIndex, NIL]]]];
RETURN;
END;
ENDCASE; -- continue
END;
FormExpressionsToLevel[2, t];
newOp ← IF t.operator = plus THEN binaryPlus ELSE binaryMinus;
PushStack[[operator, NEW[TokenBody ← [newOp, t.charIndex, NIL]]]];
RETURN;
END;
times, divide =>
BEGIN
FormExpressionsToLevel[1, t];
PushStack[[operator, NEW[TokenBody ← [t.operator, t.charIndex, NIL]]]];
RETURN;
END;
less, lessEqu, gtr, gtrEqu, equ, nEqu =>
BEGIN
FormExpressionsToLevel[3, t];
PushStack[[operator, NEW[TokenBody ← [t.operator, t.charIndex, NIL]]]];
RETURN;
END;
not =>
BEGIN
FormExpressionsToLevel[4, t];
PushStack[[operator, NEW[TokenBody ← [not, t.charIndex, NIL]]]];
RETURN;
END;
and =>
BEGIN
FormExpressionsToLevel[5, t];
PushStack[[operator, NEW[TokenBody ← [and, t.charIndex, NIL]]]];
RETURN;
END;
or =>
BEGIN
FormExpressionsToLevel[6, t];
PushStack[[operator, NEW[TokenBody ← [or, t.charIndex, NIL]]]];
RETURN;
END;
if, leftParen, assign =>
BEGIN
PushStack[[operator, NEW[TokenBody ← [t.operator, t.charIndex, NIL]]]];
RETURN;
END;
then, else =>
BEGIN
FormExpressionsToLevel[7, t]; -- perhaps something subtle here about then and else?????
PushStack[[operator, NEW[TokenBody ← [t.operator, t.charIndex, NIL]]]];
RETURN;
END;
rightParen =>
BEGIN
FormExpressionsToLevel[7, t];
RETURN;
END;
assign =>
BEGIN
IF NOT IsIdExp[S1] OR NOT IsOp[S2, start] THEN ERROR SyntaxError[t];
PushStack[[operator, NEW[TokenBody ← [t.operator, t.charIndex, NIL]]]];
END;
colon =>
BEGIN
IF IsOp[S1, start] THEN PushStack[[expression, NIL]];
IF NOT IsExp[S1] AND NOT IsOp[S1, start] AND NOT IsOp[S1, assign] THEN
PushStack[[expression, NIL]];
FormExpressionsToLevel[7, t];
IF IsOp[S1, start] OR IsExp[S1] OR IsOp[S1, assign] THEN
BEGIN
PushStack[[operator, NEW[TokenBody ← [t.operator, t.charIndex, NIL]]]];
END
ELSE ERROR SyntaxError[t];
END;
nil =>
BEGIN
IF IsOp[S1, start] THEN
BEGIN
PushStack[[expression, NIL]];
RETURN;
END;
IF NOT IsExp[S1] AND NOT IsOp[S1, start] AND NOT IsOp[S1, assign] THEN
PushStack[[expression, NIL]];
FormExpressionsToLevel[8, t];
IF NOT IsExp[S1] OR NOT IsOp[S2, start] THEN ERROR SyntaxError[t];
END;
bad =>
ERROR SyntaxError[t];
ENDCASE => ERROR;
END;
ParseGCellIdentifierName: PROCEDURE[name: Rope.ROPE] RETURNS[Identifier] =
BEGIN
tableIndex: IdTableSetIndex ← self; -- tentative
IF Rope.Length[name] > 1 AND Rope.Fetch[name, 1] = '. THEN SELECT Rope.Fetch[name, 0] FROM
'n => tableIndex ← n;
'e => tableIndex ← e;
's => tableIndex ← s;
'w => tableIndex ← w;
'p => tableIndex ← page;
'g => tableIndex ← global;
ENDCASE => NULL;
IF tableIndex # self THEN RETURN[NEW[IdentifierBody←[tableIndex, Rope.Substr[name, 2, Rope.Length[name]-2], NIL]]]
ELSE RETURN[NEW[IdentifierBody←[self, name, NIL]]];
END;
ParseHCellIdentifierName: PROCEDURE[name: Rope.ROPE] RETURNS[Rope.ROPE] =
BEGIN
nDots: CARDINAL ← 0; -- tentative
pos1: INT ← 0; -- initial
WHILE (pos1 ← Rope.Find[name, Rope.FromChar[IO.CR], pos1]+1) # 0 DO
nDots ← nDots+1;
IF nDots > 2 THEN SyntaxError[NEW[TokenBody←[nil, pos1, NIL]]]
ENDLOOP;
RETURN[name];
END;
FormExpressionsToLevel: PROCEDURE[level: CARDINAL, for: Token] =
BEGIN
operator2: Operator;
WHILE TRUE DO
IF S1.case # expression THEN ERROR SyntaxError[for];
IF S2.case # operator THEN ERROR SyntaxError[for];
operator2 ← NARROW[S2.data, Token].operator;
SELECT operator2 FROM
unaryPlus, unaryMinus =>
BEGIN
n: StackElement ← [case: expression, data: NEW[ExpressionBody ←
[operator2, S1.data]]];
PopStack[];
S1 ← n;
LOOP;
END;
times, divide =>
BEGIN
n: StackElement;
IF level < 1 THEN RETURN;
IF S3.case # expression THEN ERROR;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[operator2, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
LOOP;
END;
binaryPlus, binaryMinus =>
BEGIN
n: StackElement;
IF level < 2 THEN RETURN;
IF S3.case # expression THEN ERROR;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[operator2, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
LOOP;
END;
less, lessEqu, gtr, gtrEqu, equ, nEqu =>
BEGIN
n: StackElement;
IF level <= 3 THEN RETURN;
IF S3.case # expression THEN ERROR;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[operator2, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
LOOP;
END;
not =>
BEGIN
n: StackElement;
IF level <= 4 THEN RETURN;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[operator2, S1.data]]];
PopStack[];
S1 ← n;
LOOP;
END;
and =>
BEGIN
n: StackElement;
IF level < 5 THEN RETURN;
IF S3.case # expression THEN ERROR;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[operator2, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
LOOP;
END;
or =>
BEGIN
n: StackElement;
IF level < 6 THEN RETURN;
IF S3.case # expression THEN ERROR;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[operator2, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
LOOP;
END;
else =>
BEGIN
n: StackElement;
IF level < 7 THEN RETURN;
IF S3.case # expression THEN ERROR;
IF S4.case # operator THEN ERROR;
IF NARROW[S4.data, Token].operator # then THEN ERROR SyntaxError[for];
IF S5.case # expression THEN ERROR;
IF S6.case # operator THEN ERROR;
IF NARROW[S6.data, Token].operator # if THEN ERROR SyntaxError[for] ;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[conditional, S5.data, S3.data, S1.data]]];
PopStack[]; PopStack[]; PopStack[]; PopStack[]; PopStack[];
S1 ← n;
LOOP;
END;
if, then => RETURN;
leftParen =>
BEGIN
n: StackElement;
IF level < 7 THEN RETURN;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[parenExp, S1.data]]];
PopStack[];
S1 ← n;
LOOP;
END;
start =>
BEGIN
n: StackElement;
IF level < 8 THEN RETURN;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[topExp, NIL, S1.data, NIL]]];
S1 ← n;
RETURN;
END;
assign =>
BEGIN
n: StackElement;
IF level < 8 THEN RETURN;
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[topExp, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
RETURN;
END;
colon =>
BEGIN
n: StackElement;
IF level < 8 THEN RETURN;
IF IsOp[S4, start] THEN
BEGIN
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[topExp, NIL, S3.data, S1.data]]];
PopStack[]; PopStack[];
S1 ← n;
END
ELSE IF IsOp[S4, assign] THEN
BEGIN
n ← StackElement[case: expression, data: NEW[ExpressionBody ←
[topExp, S5.data, S3.data, S1.data]]];
PopStack[]; PopStack[]; PopStack[]; PopStack[];
S1 ← n;
END
ELSE ERROR;
RETURN;
END;
ENDCASE => ERROR;
ENDLOOP;
END;
OperatorName: PROCEDURE[operator: Operator] RETURNS[Rope.ROPE] =
BEGIN
RETURN[SELECT operator FROM
plus => "plus",
minus => "minus",
times => "times",
divide => "divide",
leftParen => "leftParen",
rightParen => "rightParen",
if => "if",
then => "then",
else => "else",
less => "less",
lessEqu => "lessEqu",
gtr => "gtr",
gtrEqu => "gtrEqu",
equ => "equ",
nEqu => "nEqu",
not => "not",
and => "and",
or => "or",
assign => "assign",
colon => "colon",
token => "token",
unaryPlus => "unaryPlus",
unaryMinus => "unaryMinus",
binaryPlus => "binaryPlus",
binaryMinus => "binaryMinus",
conditional => "conditional",
parenExp => "parenExp",
bad => "bad",
start => "start",
nil => "nil",
topExp => "topExp",
ENDCASE => ERROR];
END;
ShowExpression: PROCEDURE[stream: IO.STREAM, exp: Expression] =
BEGIN
IF exp = NIL THEN IO.PutF[stream, " NIL"]
ELSE
SELECT exp.operator FROM
nil =>
BEGIN
IO.PutF[stream, " %g(", IO.rope[OperatorName[exp.operator]]];
IF exp.data1 # NIL OR exp.data2 # NIL OR exp.data3 # NIL THEN ERROR;
END;
token =>
BEGIN
IO.PutF[stream, " %g(", IO.rope[OperatorName[exp.operator]]];
ShowToken[stream, NARROW[exp.data1]];
IF exp.data2 # NIL OR exp.data3 # NIL THEN ERROR;
IO.PutF[stream, ") "];
END;
not, unaryPlus, unaryMinus, parenExp =>
BEGIN
IO.PutF[stream, " %g(", IO.rope[OperatorName[exp.operator]]];
ShowExpression[stream, NARROW[exp.data1]];
IF exp.data2 # NIL OR exp.data3 # NIL THEN ERROR;
IO.PutF[stream, ") "];
END;
times, divide, less, lessEqu, gtr, gtrEqu, equ, nEqu, and, or, binaryPlus, binaryMinus =>
BEGIN
IO.PutF[stream, " %g(", IO.rope[OperatorName[exp.operator]]];
ShowExpression[stream, NARROW[exp.data1]];
IO.PutF[stream, ","];
ShowExpression[stream, NARROW[exp.data2]];
IO.PutF[stream, ")"];
IF exp.data3 # NIL THEN ERROR;
END;
conditional =>
BEGIN
IO.PutF[stream, " %g(", IO.rope[OperatorName[exp.operator]]];
ShowExpression[stream, NARROW[exp.data1]];
IO.PutF[stream, ","];
ShowExpression[stream, NARROW[exp.data2]];
IO.PutF[stream, ","];
ShowExpression[stream, NARROW[exp.data3]];
IO.PutF[stream, ")"];
END;
topExp =>
BEGIN
IO.PutF[stream, " %g(", IO.rope[OperatorName[exp.operator]]];
ShowExpression[stream, NARROW[exp.data1]];
IO.PutF[stream, ","];
ShowExpression[stream, NARROW[exp.data2]];
IO.PutF[stream, ","];
ShowExpression[stream, NARROW[exp.data3]];
IO.PutF[stream, ")"];
END;
ENDCASE => ERROR;
END;
Punctuation: PROCEDURE[c: CHARACTER] RETURNS[BOOLEAN] =
BEGIN
SELECT c FROM
'( , '), '+, '-, '*, '/ , '<, '>, '=, ':, '←, '{ => RETURN[TRUE];
ENDCASE => RETURN[FALSE];
END;
NextToken: PROCEDURE[rope: Rope.ROPE, x: INTEGER] RETURNS[Token, INTEGER] =
BEGIN
y: INTEGER;
c: CHARACTER;
tokenRope: Rope.ROPE;
ropeLength: INTEGER ← Rope.Length[rope];
DO -- we exit this loop when we have the first non blank, non comment char, or end of the rope
IF x = ropeLength THEN RETURN[NEW[TokenBody ← [nil, x, NIL]], x];
c ← Rope.Fetch[rope, x];
IF c = ' THEN {x ← x+1; LOOP};
IF c = '{ THEN -- strip out a comment and repeat
BEGIN
depth: CARDINAL ← 1;
WHILE x < ropeLength DO
x ← x+1;
c ← Rope.Fetch[rope, x];
IF c = '{ THEN depth ← depth+1 ELSE IF c = '} THEN depth ← depth-1;
IF depth = 0 THEN {x←x+1; EXIT};
ENDLOOP;
LOOP;
END;
EXIT;
ENDLOOP;
IF Punctuation[c] THEN
BEGIN
operator: Operator ← SELECT c FROM
'( => leftParen,
') => rightParen,
'+ => plus,
'- => minus,
'* => times,
'/ => divide,
'< => IF Rope.Fetch[rope, x+1] = '= THEN lessEqu ELSE less,
'> => IF Rope.Fetch[rope, x+1] = '= THEN gtrEqu ELSE gtr,
'= => equ,
': => colon,
'← => assign,
ENDCASE => ERROR;
IF operator = lessEqu OR operator = gtrEqu THEN x ← x+1;
RETURN[NEW[TokenBody ← [operator, x, NIL]], x+1];
END;
-- not a punctuation char
y ← x;
WHILE NOT Punctuation[c] AND NOT c = ' DO
y ← y+1; IF y = ropeLength THEN EXIT; c ← Rope.Fetch[rope, y] ENDLOOP;
-- next token is <rope[x], rope[x+1], ... rope[y-1]>, i.e. starts at x, and contains y-x characters
IF y = x THEN RETURN[NEW[TokenBody ← [nil, x, NIL]], y];
tokenRope ← Rope.Substr[rope, x, y-x];
IF Ascii.Digit[Rope.Fetch[tokenRope, 0]] THEN
BEGIN
-- legal number contains all digits except 1 period, and at most 2 digits past period
z: CARDINAL ← 0;
ropeLength: CARDINAL ← Rope.Length[tokenRope];
WHILE z < ropeLength AND Ascii.Digit[Rope.Fetch[tokenRope, z]] DO z ← z+1 ENDLOOP;
IF z = ropeLength THEN RETURN[NEW[TokenBody ← [number, x, tokenRope]], y];
IF Rope.Fetch[tokenRope, z] # '. THEN
RETURN[NEW[TokenBody ← [bad, x, tokenRope]], y];
z ← z+1;
--IF ropeLength-z > 2 THEN RETURN[NEW[TokenBody ← [bad, x, tokenRope]], y];
WHILE z < ropeLength AND Ascii.Digit[Rope.Fetch[tokenRope, z]] DO z ← z+1 ENDLOOP;
IF ropeLength # z THEN RETURN[NEW[TokenBody ← [bad, x, tokenRope]], y];
RETURN[NEW[TokenBody ← [number, x, tokenRope]], y];
END
ELSE IF Ascii.Letter[Rope.Fetch[tokenRope, 0]] THEN
SELECT TRUE FROM
Rope.Equal[tokenRope, "IF"] => RETURN[NEW[TokenBody ← [if, x, NIL]], y];
Rope.Equal[tokenRope, "THEN"] => RETURN[NEW[TokenBody ← [then, x, NIL]], y];
Rope.Equal[tokenRope, "ELSE"] => RETURN[NEW[TokenBody ← [else, x, NIL]], y];
Rope.Equal[tokenRope, "NOT"] => RETURN[NEW[TokenBody ← [not, x, NIL]], y];
Rope.Equal[tokenRope, "AND"] => RETURN[NEW[TokenBody ← [and, x, NIL]], y];
Rope.Equal[tokenRope, "OR"] => RETURN[NEW[TokenBody ← [or, x, NIL]], y];
ENDCASE => RETURN[NEW[TokenBody ← [id, x, tokenRope]], y]
ELSE RETURN[NEW[TokenBody ← [bad, x, tokenRope]], y];
END;
ShowToken: PROCEDURE[stream: IO.STREAM, tkn: Token] =
BEGIN
IO.PutF[stream, "%g", IO.rope[TokenText[tkn]]]
END;
-- interface procedures
SyntaxError: PUBLIC ERROR[unexpectedToken: Token] = CODE;
ParseRope: PUBLIC PROCEDURE[rope: Rope.ROPE] RETURNS[Expression] =
{RETURN[ParseExpression[rope]]};
ParseExpression: PUBLIC PROCEDURE[rope: Rope.ROPE] RETURNS[Expression] =
{RETURN[ParseBothKindsOfExpression[rope, gCell]]};
ParseBothKindsOfExpression: PROCEDURE[rope: Rope.ROPE, parseCase: ParseCase] RETURNS[Expression] =
BEGIN
x: INTEGER ← 0;
t: Token;
stackRemainder ← NIL;
FOR I: CARDINAL IN [1..6] DO
PushStack[[operator, NEW[TokenBody ← [bad, 0, NIL]]]]
ENDLOOP;
PushStack[[operator, NEW[TokenBody ← [start, 0, NIL]]]];
[t, x] ← NextToken[rope, x];
WHILE t.operator # nil DO
AbsorbOneToken[t, parseCase];
[t, x] ← NextToken[rope, x];
ENDLOOP;
AbsorbOneToken[t, parseCase];
IF NOT IsOp[S2, start] THEN SyntaxError[t];
RETURN[NARROW[S1.data]];
END;
ParseIdentifier: PUBLIC PROCEDURE[rope: Rope.ROPE] RETURNS[Identifier] =
BEGIN
tkn: Token;
x: INTEGER;
[tkn, x] ← NextToken[rope, 0];
IF x # Rope.Length[rope] THEN SyntaxError[NEW[TokenBody←[nil, x, NIL]]];
IF tkn.operator # id THEN SyntaxError[tkn];
RETURN[ParseGCellIdentifierName[NARROW[tkn.data]]];
END;
TokenText: PUBLIC PROCEDURE[tkn: Token] RETURNS[Rope.ROPE] =
BEGIN
SELECT tkn.operator FROM
plus, minus, times, divide, leftParen, rightParen, rightParen, if, then, else, less, lessEqu, gtr, gtrEqu, equ, nEqu, not, and, or, assign, colon, unaryPlus, unaryMinus, binaryPlus, binaryMinus, conditional, parenExp, nil, bad =>
BEGIN
RETURN[OperatorName[tkn.operator]];
END;
id =>
BEGIN
SELECT TRUE FROM
ISTYPE[tkn.data, Rope.ROPE] => RETURN[NARROW[tkn.data]];
ISTYPE[tkn.data, Identifier] =>
BEGIN
id: Identifier ← NARROW[tkn.data];
RETURN[id.name];
END;
ENDCASE => RETURN["unknown"];
END;
number =>
BEGIN
data: Rope.ROPE ← NARROW[tkn.data];
RETURN[data];
END;
ENDCASE => ERROR;
END;
Test: Commander.CommandProc = TRUSTED
BEGIN
rope: Rope.ROPE;
execOut: IO.STREAM ← cmd.out;
IO.PutF[execOut, "this is the supplied commandLine: %g\n", IO.rope[cmd.commandLine]];
rope ← cmd.commandLine;
ShowExpression[execOut, ParseHCellExpression[rope
! SyntaxError =>
BEGIN
IO.PutF[execOut, "syntax error at @@@@, unexpected token = "];
ShowToken[execOut, unexpectedToken];
IO.PutF[execOut, ", rope = %g@@@@%g\n",
IO.rope[Rope.Substr[rope, 0, unexpectedToken.charIndex]],
IO.rope[Rope.Substr[rope, unexpectedToken.charIndex,
Rope.Length[rope]-unexpectedToken.charIndex]]];
CONTINUE
END].exp];
END;
-- new HCell interface procedures
ParseHCellExpression: PUBLIC PROCEDURE[text: Rope.ROPE] RETURNS[HCellExpression] =
{RETURN[[ParseBothKindsOfExpression[text, hCell]]]};
ParseHCellIdentifier: PUBLIC PROCEDURE[text: Rope.ROPE] RETURNS[HCellIdentifier] =
BEGIN
tkn: Token;
x: INTEGER;
[tkn, x] ← NextToken[text, 0];
IF x # Rope.Length[text] THEN SyntaxError[NEW[TokenBody←[nil, x, NIL]]];
IF tkn.operator # id THEN SyntaxError[tkn];
RETURN[[ParseHCellIdentifierName[NARROW[tkn.data]]]];
END;
-- module main program
Commander.Register[key: "TestTokens", proc: Test, doc: ""];
END..
-- July 11, 1982 5:25 pm: Sturgis, started ExpressionsImpl.mesa
-- July 18, 1982 2:39 pm: greatly simplify expression representation.
-- RTE: July 18, 1982 2:39 pm: subexpressions inserted backwards. (error was in original code also).
-- remark: July 18, 1982 2:46 pm: correctly parses a token sequence containing: ( IF ( a + b ) THEN c ELSE d + e * f ).
-- RTE: July 18, 1982 4:11 pm: computed id was the chars x+1, x+2, ... , rather than x, x+1, x+2, ...
-- RTE: July 18, 1982 4:15 pm: rope not terminating in blank incorrectly handled.
-- RTE: July 18, 1982 5:21 pm: must absorb the trailing "nil" to force non parenthesised expressions to form.
--remark: July 18, 1982 5:28 pm: expressions seem to work, note: must use "'" in front of "*" on the command line.
--remark: July 22, 1982 5:46 pm: after assorted run time errors (about 1 hour of coding and 1 hour of debugging) I now have expressions which contain ← and : and supply a "topExp" as a result. syntax errors are still mostly found late, and client must have non null characters after : to force recognition of that case (non NIL third item in a topExp), but on the whole it seems usable.
-- remark: July 23, 1982 2:30 pm: add number syntax.
-- remark: July 23, 1982 3:16 pm: add {} comment convention.
-- change: July 28, 1982 11:01 am: rename as ExpressionSyntaxImpl, replace Rope.Ref by Rope.ROPE, IOStream by IO, IO.Handle by IO.STREAM, add TRUSTED to Test.
--change: July 30, 1982 10:39 am: added TokenText
-- change: August 3, 1982 10:21 am: begin changes to allow some special top level forms with missing expressions. This will take a few experiments.
-- RTE: August 4, 1982 11:02 am: unary minus could not be first char in an expression. Had to add start to the list of operators that can precede a unary minus.
-- RTE: August 4, 1982 2:23 pm: (change lost due to dorado crash). allow colon to precede unary minus.
-- RTE: August 11, 1982 3:42 pm: NextToken did not read the last character in a rope.
-- RTE: August 11, 1982 3:47 pm: did not get a syntax error on "a+", so modified ParseRope to check for start at S2.
-- RTE: August 11, 1982 4:02 pm: previous fix did not do it, so modified test for inserting null expression in AbsobOneToken, cases : and assign.
-- RTE: August 11, 1982 5:29 pm: trouble with ":0.00", so try putting in a NIL expression before ":" if S1 = start.
-- RTE: September 17, 1982 3:50 pm: allow more than 2 digits after decimal point, since floating point output code generates them.
-- change: September 26, 1982 2:53 pm: add ParseExpression (same as ParseRope) and ParseIdentifier (new)
-- change: October 4, 1982 2:23 pm: add code to absorbOneToken, in nil case, to put a null expression on the stack if S1 is start. This should allow empty expressions. Intention is that they will evaluate to 0.
-- CTE: February 10, 1983 5:35 pm: convert to 4.0
-- Change: June 22, 1984 2:18:12 pm PDT: convert to 5.2
-- Change: July 12, 1984 2:24:47 pm PDT: add HCell parse case (i.e. identifiers are now three part names)