677 lines
17 KiB
Plaintext
677 lines
17 KiB
Plaintext
|
|
{ Copyright (c) 1989,90 by Borland International, Inc. }
|
|
|
|
unit TCParser;
|
|
{ Turbo Pascal 6.0 object-oriented example parser.
|
|
This unit is used by TCALC.PAS.
|
|
See TCALC.DOC for an more information about this example.
|
|
}
|
|
|
|
{$N+,S-}
|
|
|
|
interface
|
|
|
|
uses Crt, Dos, TCUtil, TCScreen, TCCell, TCCellSp, TCLStr;
|
|
|
|
const
|
|
ParserStackSize = 10;
|
|
MaxFuncNameLen = 5;
|
|
ExpLimit = 11356;
|
|
SqrLimit = 1E2466;
|
|
MaxExpLen = 4;
|
|
TotalErrors = 7;
|
|
ErrParserStack = 1;
|
|
ErrBadRange = 2;
|
|
ErrExpression = 3;
|
|
ErrOperator = 4;
|
|
ErrOpenParen = 5;
|
|
ErrCell = 6;
|
|
ErrOpCloseParen = 7;
|
|
ErrorMessages : array[1..TotalErrors] of String[33] =
|
|
('Parser stack overflow', 'Bad cell range', 'Expected expression',
|
|
'Expected operator', 'Expected open paren', 'Expected cell',
|
|
'Expected operator or closed paren');
|
|
|
|
type
|
|
ErrorRange = 0..TotalErrors;
|
|
TokenTypes = (Plus, Minus, Times, Divide, Expo, Colon, OParen, CParen,
|
|
Num, CellT, Func, EOL, Bad);
|
|
TokenRec = record
|
|
State : Byte;
|
|
case Byte of
|
|
0 : (Value : Extended);
|
|
1 : (CP : CellPos);
|
|
2 : (FuncName : String[MaxFuncNameLen]);
|
|
end;
|
|
ParserObj = object
|
|
Inp : LStringPtr;
|
|
ParserHash : CellHashTablePtr;
|
|
PMaxCols : Word;
|
|
PMaxRows : Word;
|
|
Position : Word;
|
|
CurrToken : TokenRec;
|
|
StackTop : 0..ParserStackSize;
|
|
TokenError : ErrorRange;
|
|
ParseError : Boolean;
|
|
CType : CellTypes;
|
|
ParseValue : Extended;
|
|
Stack : array[1..ParserStackSize] of TokenRec;
|
|
TokenType : TokenTypes;
|
|
TokenLen : Word;
|
|
MathError, IsFormula : Boolean;
|
|
constructor Init(InitHash : CellHashTablePtr; InitInp : LStringPtr;
|
|
InitPMaxCols, InitPMaxRows : Word);
|
|
function IsFunc(S : String) : Boolean;
|
|
procedure Push(Token : TokenRec);
|
|
procedure Pop(var Token : TokenRec);
|
|
function GotoState(Production : Word) : Word;
|
|
procedure Shift(State : Word);
|
|
procedure Reduce(Reduction : Word);
|
|
function NextToken : TokenTypes;
|
|
procedure Parse;
|
|
function CellValue(P : CellPos) : Extended;
|
|
end;
|
|
|
|
var
|
|
Parser : ParserObj;
|
|
|
|
implementation
|
|
|
|
constructor ParserObj.Init(InitHash : CellHashTablePtr;
|
|
InitInp : LStringPtr;
|
|
InitPMaxCols, InitPMaxRows : Word);
|
|
{ Initializes the parser }
|
|
begin
|
|
ParserHash := InitHash;
|
|
Inp := InitInp;
|
|
PMaxCols := InitPMaxCols;
|
|
PMaxRows := InitPMaxRows;
|
|
Position := 1;
|
|
StackTop := 0;
|
|
TokenError := 0;
|
|
MathError := False;
|
|
IsFormula := False;
|
|
ParseError := False;
|
|
end; { ParserObj.Init }
|
|
|
|
function ParserObj.IsFunc(S : String) : Boolean;
|
|
{ Checks to see if the parser is about to read a function }
|
|
var
|
|
Counter, SLen : Word;
|
|
begin
|
|
with Inp^ do
|
|
begin
|
|
SLen := System.Length(S);
|
|
for Counter := 1 to System.Length(S) do
|
|
begin
|
|
if UpCase(Data^[Pred(Position + Counter)]) <> S[Counter] then
|
|
begin
|
|
IsFunc := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
CurrToken.FuncName := UpperCase(Copy(Position, SLen));
|
|
Inc(Position, SLen);
|
|
IsFunc := True;
|
|
end; { with }
|
|
end; { IsFunc }
|
|
|
|
function ParserObj.NextToken : TokenTypes;
|
|
{ Gets the next Token from the Input stream }
|
|
var
|
|
NumString : String[80];
|
|
FormLen, Place, TLen, NumLen, Check : Word;
|
|
Ch, FirstChar : Char;
|
|
Decimal : Boolean;
|
|
begin
|
|
with Inp^ do
|
|
begin
|
|
while (Position <= Length) and (Data^[Position] = ' ') do
|
|
Inc(Position);
|
|
TokenLen := Position;
|
|
if Position > Length then
|
|
begin
|
|
NextToken := EOL;
|
|
TokenLen := 0;
|
|
Exit;
|
|
end;
|
|
Ch := UpCase(Data^[Position]);
|
|
if Ch in ['0'..'9', '.'] then
|
|
begin
|
|
NumString := '';
|
|
TLen := Position;
|
|
Decimal := False;
|
|
while (TLen <= Length) and
|
|
((Data^[TLen] in ['0'..'9']) or
|
|
((Data^[TLen] = '.') and (not Decimal))) do
|
|
begin
|
|
NumString := NumString + Data^[TLen];
|
|
if Ch = '.' then
|
|
Decimal := True;
|
|
Inc(TLen);
|
|
end;
|
|
if (TLen = 2) and (Ch = '.') then
|
|
begin
|
|
NextToken := BAD;
|
|
TokenLen := 0;
|
|
Exit;
|
|
end;
|
|
if (TLen <= Length) and ((Data^[TLen] = 'E') or
|
|
(Data^[TLen] = 'e')) then
|
|
begin
|
|
NumString := NumString + 'E';
|
|
Inc(TLen);
|
|
if Data^[TLen] in ['+', '-'] then
|
|
begin
|
|
NumString := NumString + Data^[TLen];
|
|
Inc(TLen);
|
|
end;
|
|
NumLen := 1;
|
|
while (TLen <= Length) and (Data^[TLen] in ['0'..'9']) and
|
|
(NumLen <= MaxExpLen) do
|
|
begin
|
|
NumString := NumString + Data^[TLen];
|
|
Inc(NumLen);
|
|
Inc(TLen);
|
|
end;
|
|
end;
|
|
if NumString[1] = '.' then
|
|
NumString := '0' + NumString;
|
|
Val(NumString, CurrToken.Value, Check);
|
|
if Check <> 0 then
|
|
MathError := True;
|
|
NextToken := NUM;
|
|
Inc(Position, System.Length(NumString));
|
|
TokenLen := Position - TokenLen;
|
|
Exit;
|
|
end
|
|
else if Ch in Letters then
|
|
begin
|
|
if IsFunc('ABS') or
|
|
IsFunc('ATAN') or
|
|
IsFunc('COS') or
|
|
IsFunc('EXP') or
|
|
IsFunc('LN') or
|
|
IsFunc('ROUND') or
|
|
IsFunc('SIN') or
|
|
IsFunc('SQRT') or
|
|
IsFunc('SQR') or
|
|
IsFunc('TRUNC') then
|
|
begin
|
|
NextToken := FUNC;
|
|
TokenLen := Position - TokenLen;
|
|
Exit;
|
|
end;
|
|
if FormulaStart(Inp, Position, PMaxCols, PMaxRows, CurrToken.CP,
|
|
FormLen) then
|
|
begin
|
|
Inc(Position, FormLen);
|
|
IsFormula := True;
|
|
NextToken := CELLT;
|
|
TokenLen := Position - TokenLen;
|
|
Exit;
|
|
end
|
|
else begin
|
|
NextToken := BAD;
|
|
TokenLen := 0;
|
|
Exit;
|
|
end;
|
|
end
|
|
else begin
|
|
case Ch of
|
|
'+' : NextToken := PLUS;
|
|
'-' : NextToken := MINUS;
|
|
'*' : NextToken := TIMES;
|
|
'/' : NextToken := DIVIDE;
|
|
'^' : NextToken := EXPO;
|
|
':' : NextToken := COLON;
|
|
'(' : NextToken := OPAREN;
|
|
')' : NextToken := CPAREN;
|
|
else begin
|
|
NextToken := BAD;
|
|
TokenLen := 0;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Inc(Position);
|
|
TokenLen := Position - TokenLen;
|
|
Exit;
|
|
end; { case }
|
|
end; { with }
|
|
end; { ParserObj.NextToken }
|
|
|
|
procedure ParserObj.Push(Token : TokenRec);
|
|
{ Pushes a new Token onto the stack }
|
|
begin
|
|
if StackTop = ParserStackSize then
|
|
TokenError := ErrParserStack
|
|
else begin
|
|
Inc(StackTop);
|
|
Stack[StackTop] := Token;
|
|
end;
|
|
end; { ParserObj.Push }
|
|
|
|
procedure ParserObj.Pop(var Token : TokenRec);
|
|
{ Pops the top Token off of the stack }
|
|
begin
|
|
Token := Stack[StackTop];
|
|
Dec(StackTop);
|
|
end; { ParserObj.Pop }
|
|
|
|
function ParserObj.GotoState(Production : Word) : Word;
|
|
{ Finds the new state based on the just-completed production and the
|
|
top state.
|
|
}
|
|
var
|
|
State : Word;
|
|
begin
|
|
State := Stack[StackTop].State;
|
|
if (Production <= 3) then
|
|
begin
|
|
case State of
|
|
0 : GotoState := 1;
|
|
9 : GotoState := 19;
|
|
20 : GotoState := 28;
|
|
end; { case }
|
|
end
|
|
else if Production <= 6 then
|
|
begin
|
|
case State of
|
|
0, 9, 20 : GotoState := 2;
|
|
12 : GotoState := 21;
|
|
13 : GotoState := 22;
|
|
end; { case }
|
|
end
|
|
else if Production <= 8 then
|
|
begin
|
|
case State of
|
|
0, 9, 12, 13, 20 : GotoState := 3;
|
|
14 : GotoState := 23;
|
|
15 : GotoState := 24;
|
|
16 : GotoState := 25;
|
|
end; { case }
|
|
end
|
|
else if Production <= 10 then
|
|
begin
|
|
case State of
|
|
0, 9, 12..16, 20 : GotoState := 4;
|
|
end; { case }
|
|
end
|
|
else if Production <= 12 then
|
|
begin
|
|
case State of
|
|
0, 9, 12..16, 20 : GotoState := 6;
|
|
5 : GotoState := 17;
|
|
end; { case }
|
|
end
|
|
else begin
|
|
case State of
|
|
0, 5, 9, 12..16, 20 : GotoState := 8;
|
|
end; { case }
|
|
end;
|
|
end; { ParserObj.GotoState }
|
|
|
|
function ParserObj.CellValue(P : CellPos) : Extended;
|
|
{ Returns the value of a cell }
|
|
var
|
|
CPtr : CellPtr;
|
|
begin
|
|
CPtr := ParserHash^.Search(P);
|
|
with CPtr^ do
|
|
begin
|
|
if (not LegalValue) or HasError then
|
|
begin
|
|
MathError := True;
|
|
CellValue := 0;
|
|
end
|
|
else
|
|
CellValue := CurrValue;
|
|
end; { with }
|
|
end; { ParserObj.CellValue }
|
|
|
|
procedure ParserObj.Shift(State : Word);
|
|
{ Shifts a Token onto the stack }
|
|
begin
|
|
CurrToken.State := State;
|
|
Push(CurrToken);
|
|
TokenType := NextToken;
|
|
end; { ParserObj.Shift }
|
|
|
|
procedure ParserObj.Reduce(Reduction : Word);
|
|
{ Completes a reduction }
|
|
var
|
|
Token1, Token2 : TokenRec;
|
|
Counter : CellPos;
|
|
begin
|
|
case Reduction of
|
|
1 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
Pop(Token2);
|
|
CurrToken.Value := Token1.Value + Token2.Value;
|
|
end;
|
|
2 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
Pop(Token2);
|
|
CurrToken.Value := Token2.Value - Token1.Value;
|
|
end;
|
|
4 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
Pop(Token2);
|
|
CurrToken.Value := Token1.Value * Token2.Value;
|
|
end;
|
|
5 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
Pop(Token2);
|
|
if Token1.Value = 0 then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Token2.Value / Token1.Value;
|
|
end;
|
|
7 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
Pop(Token2);
|
|
if Token2.Value <= 0 then
|
|
MathError := True
|
|
else if (Token1.Value * Ln(Token2.Value) < -ExpLimit) or
|
|
(Token1.Value * Ln(Token2.Value) > ExpLimit) then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Exp(Token1.Value * Ln(Token2.Value));
|
|
end;
|
|
9 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
CurrToken.Value := -Token1.Value;
|
|
end;
|
|
11 : begin
|
|
Pop(Token1);
|
|
Pop(Token2);
|
|
Pop(Token2);
|
|
CurrToken.Value := 0;
|
|
if Token1.CP.Row = Token2.CP.Row then
|
|
begin
|
|
if Token1.CP.Col < Token2.CP.Col then
|
|
TokenError := ErrBadRange
|
|
else begin
|
|
Counter.Row := Token1.CP.Row;
|
|
for Counter.Col := Token2.CP.Col to Token1.CP.Col do
|
|
CurrToken.Value := CurrToken.Value + CellValue(Counter);
|
|
end;
|
|
end
|
|
else if Token1.CP.Col = Token2.CP.Col then
|
|
begin
|
|
if Token1.CP.Row < Token2.CP.Row then
|
|
TokenError := ErrBadRange
|
|
else begin
|
|
Counter.Col := Token1.CP.Col;
|
|
for Counter.Row := Token2.CP.Row to Token1.CP.Row do
|
|
CurrToken.Value := CurrToken.Value + CellValue(Counter);
|
|
end;
|
|
end
|
|
else if (Token1.CP.Col >= Token2.CP.Col) and
|
|
(Token1.CP.Row >= Token2.CP.Row) then
|
|
begin
|
|
for Counter.Row := Token2.CP.Row to Token1.CP.Row do
|
|
begin
|
|
for Counter.Col := Token2.CP.Col to Token1.CP.Col do
|
|
CurrToken.Value := CurrToken.Value + CellValue(Counter);
|
|
end;
|
|
end
|
|
else
|
|
TokenError := ErrBadRange;
|
|
end;
|
|
13 : begin
|
|
Pop(CurrToken);
|
|
CurrToken.Value := CellValue(CurrToken.CP);
|
|
end;
|
|
14 : begin
|
|
Pop(Token1);
|
|
Pop(CurrToken);
|
|
Pop(Token1);
|
|
end;
|
|
16 : begin
|
|
Pop(Token1);
|
|
Pop(CurrToken);
|
|
Pop(Token1);
|
|
Pop(Token1);
|
|
if Token1.FuncName = 'ABS' then
|
|
CurrToken.Value := Abs(CurrToken.Value)
|
|
else if Token1.FuncName = 'ATAN' then
|
|
CurrToken.Value := ArcTan(CurrToken.Value)
|
|
else if Token1.FuncName = 'COS' then
|
|
CurrToken.Value := Cos(CurrToken.Value)
|
|
else if Token1.FuncName = 'EXP' then
|
|
begin
|
|
if (CurrToken.Value < -ExpLimit) or (CurrToken.Value > ExpLimit) then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Exp(CurrToken.Value);
|
|
end
|
|
else if Token1.FuncName = 'LN' then
|
|
begin
|
|
if CurrToken.Value <= 0 then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Ln(CurrToken.Value);
|
|
end
|
|
else if Token1.FuncName = 'ROUND' then
|
|
begin
|
|
if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Round(CurrToken.Value);
|
|
end
|
|
else if Token1.FuncName = 'SIN' then
|
|
CurrToken.Value := Sin(CurrToken.Value)
|
|
else if Token1.FuncName = 'SQRT' then
|
|
begin
|
|
if CurrToken.Value < 0 then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Sqrt(CurrToken.Value);
|
|
end
|
|
else if Token1.FuncName = 'SQR' then
|
|
begin
|
|
if (CurrToken.Value < -SQRLIMIT) or (CurrToken.Value > SQRLIMIT) then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Sqr(CurrToken.Value);
|
|
end
|
|
else if Token1.FuncName = 'TRUNC' then
|
|
begin
|
|
if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
|
|
MathError := True
|
|
else
|
|
CurrToken.Value := Trunc(CurrToken.Value);
|
|
end;
|
|
end;
|
|
3, 6, 8, 10, 12, 15 : Pop(CurrToken);
|
|
end; { case }
|
|
CurrToken.State := GotoState(Reduction);
|
|
Push(CurrToken);
|
|
end; { ParserObj.Reduce }
|
|
|
|
procedure ParserObj.Parse;
|
|
{ Parses an input stream }
|
|
var
|
|
FirstToken : TokenRec;
|
|
Accepted : Boolean;
|
|
begin
|
|
Position := 1;
|
|
StackTop := 0;
|
|
TokenError := 0;
|
|
MathError := False;
|
|
IsFormula := False;
|
|
ParseError := False;
|
|
with Inp^ do
|
|
begin
|
|
if (Length = 2) and (Data^[1] = RepeatFirstChar) then
|
|
begin
|
|
CType := ClRepeat;
|
|
Exit;
|
|
end;
|
|
if Data^[1] = TextFirstChar then
|
|
begin
|
|
CType := ClText;
|
|
Exit;
|
|
end;
|
|
end; { with }
|
|
Accepted := False;
|
|
FirstToken.State := 0;
|
|
FirstToken.Value := 0;
|
|
Push(FirstToken);
|
|
TokenType := NextToken;
|
|
repeat
|
|
case Stack[StackTop].State of
|
|
0, 9, 12..16, 20 : begin
|
|
if TokenType = NUM then
|
|
Shift(10)
|
|
else if TokenType = CELLT then
|
|
Shift(7)
|
|
else if TokenType = FUNC then
|
|
Shift(11)
|
|
else if TokenType = MINUS then
|
|
Shift(5)
|
|
else if TokenType = OPAREN then
|
|
Shift(9)
|
|
else begin
|
|
TokenError := ErrExpression;
|
|
Dec(Position, TokenLen);
|
|
end;
|
|
end;
|
|
1 : begin
|
|
if TokenType = EOL then
|
|
Accepted := True
|
|
else if TokenType = PLUS then
|
|
Shift(12)
|
|
else if TokenType = MINUS then
|
|
Shift(13)
|
|
else begin
|
|
TokenError := ErrOperator;
|
|
Dec(Position, TokenLen);
|
|
end;
|
|
end;
|
|
2 : begin
|
|
if TokenType = TIMES then
|
|
Shift(14)
|
|
else if TokenType = DIVIDE then
|
|
Shift(15)
|
|
else
|
|
Reduce(3);
|
|
end;
|
|
3 : Reduce(6);
|
|
4 : begin
|
|
if TokenType = EXPO then
|
|
Shift(16)
|
|
else
|
|
Reduce(8);
|
|
end;
|
|
5 : begin
|
|
if TokenType = NUM then
|
|
Shift(10)
|
|
else if TokenType = CELLT then
|
|
Shift(7)
|
|
else if TokenType = FUNC then
|
|
Shift(11)
|
|
else if TokenType = OPAREN then
|
|
Shift(9)
|
|
else
|
|
TokenError := ErrExpression;
|
|
end;
|
|
6 : Reduce(10);
|
|
7 : begin
|
|
if TokenType = COLON then
|
|
Shift(18)
|
|
else
|
|
Reduce(13);
|
|
end;
|
|
8 : Reduce(12);
|
|
10 : Reduce(15);
|
|
11 : begin
|
|
if TokenType = OPAREN then
|
|
Shift(20)
|
|
else
|
|
TokenError := ErrOpenParen;
|
|
end;
|
|
17 : Reduce(9);
|
|
18 : begin
|
|
if TokenType = CELLT then
|
|
Shift(26)
|
|
else
|
|
TokenError := ErrCell;
|
|
end;
|
|
19 : begin
|
|
if TokenType = PLUS then
|
|
Shift(12)
|
|
else if TokenType = MINUS then
|
|
Shift(13)
|
|
else if TokenType = CPAREN then
|
|
Shift(27)
|
|
else
|
|
TokenError := ErrOpCloseParen;
|
|
end;
|
|
21 : begin
|
|
if TokenType = TIMES then
|
|
Shift(14)
|
|
else if TokenType = DIVIDE then
|
|
Shift(15)
|
|
else
|
|
Reduce(1);
|
|
end;
|
|
22 : begin
|
|
if TokenType = TIMES then
|
|
Shift(14)
|
|
else if TokenType = DIVIDE then
|
|
Shift(15)
|
|
else
|
|
Reduce(2);
|
|
end;
|
|
23 : Reduce(4);
|
|
24 : Reduce(5);
|
|
25 : Reduce(7);
|
|
26 : Reduce(11);
|
|
27 : Reduce(14);
|
|
28 : begin
|
|
if TokenType = PLUS then
|
|
Shift(12)
|
|
else if TokenType = MINUS then
|
|
Shift(13)
|
|
else if TokenType = CPAREN then
|
|
Shift(29)
|
|
else
|
|
TokenError := ErrOpCloseParen;
|
|
end;
|
|
29 : Reduce(16);
|
|
end; { case }
|
|
until Accepted or (TokenError <> 0);
|
|
if TokenError <> 0 then
|
|
begin
|
|
with Scr do
|
|
begin
|
|
if TokenError = ErrBadRange then
|
|
Dec(Position, TokenLen);
|
|
PrintError(ErrorMessages[TokenError]);
|
|
Exit;
|
|
end; { with }
|
|
end;
|
|
if IsFormula then
|
|
CType := ClFormula
|
|
else
|
|
CType := ClValue;
|
|
if MathError then
|
|
begin
|
|
ParseError := True;
|
|
ParseValue := 0;
|
|
Exit;
|
|
end;
|
|
ParseError := False;
|
|
ParseValue := Stack[StackTop].Value;
|
|
end; { ParserObj.Parse }
|
|
|
|
end.
|