677 lines
17 KiB
Plaintext
677 lines
17 KiB
Plaintext
|
||
{ Copyright (c) 1989 by Borland International, Inc. }
|
||
|
||
unit TCParser;
|
||
{ Turbo Pascal 5.5 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.
|
||
|