Где-нибудь есть пример работы с TParser в FPC? Какие существуют альтернативы?
Задача - разобрать строки вида
Если(Организация.СистемаНалогОблож = СистемыНалогОблож.УСНДоход)Тогда(РазмерНалог := 0.06);
Если(Организация.СистемаНалогОблож = СистемыНалогОблож.УСНПрибыль)Тогда(РазмерНалог := 0.15);
UPD: ругань была, если добавлять модель parser в Uses. Без него работает, но хороший пример с переменными будет очень кстати ^_^
Добавлено спустя 57 минут 32 секунды:
Данный пример падает без объявления войны
Добавлено спустя 8 минут 47 секунд:
Разобрался, почему падает.
- Код: Выделить всё
function TExpressionParser.EvalExpr: double;
begin
Result := EvalTerm;
if SkipToken('+') then
Result := Result + EvalExpr
else if SkipToken('-') then
Result := Result - EvalExpr;
end;
Здесь Result := Result + EvalExpr, фактически, сложит два result'а.
Добавлено спустя 15 часов 23 минуты 16 секунд:
Вот относительно рабочий пример:
- Код: Выделить всё
Unit ExpressionParser;
{$mode objfpc}{$H+}
Interface
uses
Classes;
Type
{ TExpressionParser }
TExpressionParser = Class(TParser)
Private
bX, bY: Double;
Function SkipToken(Const Value: Char): Boolean;
Procedure EvalItem(Var aValue: Double);
Procedure EvalFactor(Var aValue: Double);
Procedure EvalTerm(Var aValue: Double);
Public
Procedure EvalExpr(Var aValue: Double);
Procedure SetX(Const aX: Double);
Procedure SetY(Const aY: Double);
End;
implementation
Uses
SysUtils;
Function TExpressionParser.SkipToken(Const Value: Char): Boolean;
begin
Result := Token = Value;
If Result Then
NextToken;
end;
Procedure TExpressionParser.EvalItem(Var aValue: Double);
Var
aBuffer: Double;
aTokenIndex: integer = 0;
Begin
Case Token of
toInteger: aValue := TokenInt;
toFloat: aValue := TokenFloat;
'(':
Begin
NextToken;
EvalExpr(aValue);
CheckToken(')');
End;
toSymbol:
begin
Case TokenString[1] Of
'x': aTokenIndex := 1;
'y': aTokenIndex := 2;
Else
Raise EParserError.CreateFmt('Illegal symbol "%s"', [TokenString]);
End;
Case aTokenIndex of
1: aValue := bX;
2: aValue := bY;
End;
End;
Else
Raise EParserError.CreateFmt('Illegal symbol "%s"', [TokenString]);
End;
NextToken;
end;
Procedure TExpressionParser.EvalFactor(Var aValue: Double);
Var
aBuffer: Double = 0;
Begin
Case Token of
'+':
Begin
NextToken;
EvalItem(aBuffer);
aValue += aBuffer
End;
'-':
Begin
NextToken;
EvalItem(aBuffer);
aValue := -aBuffer;
End;
Else
Begin
EvalItem(aBuffer);
aValue := aBuffer;
End;
End;
End;
Procedure TExpressionParser.EvalTerm(Var aValue: Double);
Var
aBuffer: Double = 0;
Begin
EvalFactor(aBuffer);
aValue := aBuffer;
If SkipToken('*') Then
Begin
EvalTerm(aBuffer);
aValue *= aBuffer;
End
Else
If SkipToken('/') Then
Begin
EvalTerm(aBuffer);
aValue /= aBuffer;
End;
End;
Procedure TExpressionParser.EvalExpr(Var aValue: Double);
Var
aBuffer: Double = 0;
begin
EvalTerm(aBuffer);
aValue := aBuffer;
If SkipToken('+') Then
Begin
EvalExpr(aBuffer);
aValue += aBuffer;
End
Else
If SkipToken('-') Then
Begin
EvalExpr(aBuffer);
aValue -= aBuffer;
End
end;
Procedure TExpressionParser.SetX(Const aX: Double);
Begin
bX := aX;
End;
Procedure TExpressionParser.SetY(Const aY: Double);
Begin
bY := aY;
End;
end.
Беда в том, что хотя и понимаю, как оно работает, но с нуля повторить не смогу. Плюс, почему-то отказывается вычислять выражение начинающееся не со скобки. Тем не менее, вполне себе работает:
- Код: Выделить всё
uses
sysutils, Classes, ExpressionParser;
Var
i: Integer;
aBuffer: Double;
aDate: TDateTime;
aStream: TStringStream;
aParser: TExpressionParser;
begin
aDate := Now;
aStream := TStringStream.Create('(23.34 + y) * 2.92 - 12.21 * x * -1');
aParser := TExpressionParser.Create(aStream);
aParser.SetX(10);
aParser.SetY(15);
For i := 0 To 999999 Do
Begin
aStream.Seek(0, soFromBeginning);
aParser.EvalExpr(aBuffer);
End;
aParser.Free;
aStream.Free;
WriteLn(aBuffer:10:10); // 234.0528000000
WriteLn(FormatDateTime('ss:zz', Now - aDate)); // 09:597
end.
Буду рад пояснениям и рекомендациям по увеличению быстродействия ^_^ А особенно - как реализовать булеву логику? Всякие =/If/Then и т.п.
Добавлено спустя 1 час 55 минут 51 секунду:
Почти получилось:
- Код: Выделить всё
Unit ExpressionParser;
{$mode objfpc}{$H+}
Interface
uses
Classes;
Type
{ TExpressionParser }
TExpressionParser = Class(TParser)
Private
bX, bY: Double;
Function SkipToken(Const Value: Char): Boolean;
Procedure EvalCondition(Var aValue: Boolean);
Procedure EvalItem(Var aValue: Double);
Procedure EvalFactor(Var aValue: Double);
Procedure EvalTerm(Var aValue: Double);
Public
Procedure EvalExpr(Var aValue: Double);
Procedure SetX(Const aX: Double);
Procedure SetY(Const aY: Double);
End;
implementation
Uses
SysUtils;
Function TExpressionParser.SkipToken(Const Value: Char): Boolean;
begin
Result := Token = Value;
If Result Then
NextToken;
end;
Procedure TExpressionParser.EvalCondition(Var aValue: Boolean);
Const
ckEqual = 1;
ckNotEqual = 2;
ckMore = 3;
ckNotMore = 4;
ckLess = 5;
ckNotLess = 6;
Var
aConditionKind: Integer = -1;
aLeftSide, aRightSide: Double;
Begin
//TODO: too sad condition evaluate
CheckToken('('); NextToken;
EvalExpr(aLeftSide);
Case TokenString Of
'=': aConditionKind := ckEqual;
'>': aConditionKind := ckMore;
'<': aConditionKind := ckLess;
'!':
Case NextToken Of
'=': aConditionKind := ckNotEqual;
'>': aConditionKind := ckNotMore;
'<': aConditionKind := ckNotLess;
End;
End;
NextToken;
EvalExpr(aRightSide);
CheckToken(')'); NextToken;
Case aConditionKind Of
ckEqual: aValue := aLeftSide = aRightSide;
ckNotEqual: aValue := Not(aLeftSide = aRightSide);
ckMore: aValue := aLeftSide > aRightSide;
ckNotMore: aValue := Not(aLeftSide > aRightSide);
ckLess: aValue := aLeftSide < aRightSide;
ckNotLess: aValue := Not(aLeftSide < aRightSide);
End;
End;
Procedure TExpressionParser.EvalItem(Var aValue: Double);
Var
aBuffer, aThen: Double;
aElse: Double = 0;
aTokenIndex: integer = 0;
aCondtion: Boolean;
aNeedNext: Boolean = TRUE;
Begin
Case Token of
toEOF: WriteLn('WTF');
toInteger: aValue := TokenInt;
toFloat: aValue := TokenFloat;
'(':
Begin
NextToken;
EvalExpr(aBuffer);
aValue := aBuffer;
CheckToken(')');
End;
toSymbol:
begin
Case TokenString Of
'x': aTokenIndex := 1;
'y': aTokenIndex := 2;
'If':
Begin
NextToken;
EvalCondition(aCondtion);
CheckTokenSymbol('Then'); NextToken;
EvalExpr(aThen);
CheckTokenSymbol('Else'); NextToken;
EvalExpr(aElse);
If aCondtion Then aValue := aThen
Else aValue := aElse;
aNeedNext := FALSE;
End
Else
Raise EParserError.CreateFmt('Illegal symbol "%s"', [TokenString]);
End;
Case aTokenIndex of
1: aValue := bX;
2: aValue := bY;
End;
End;
Else
Raise EParserError.CreateFmt('Illegal symbol "%s"', [TokenString]);
End;
If aNeedNext Then
NextToken;
end;
Procedure TExpressionParser.EvalFactor(Var aValue: Double);
Var
aBuffer: Double = 0;
Begin
Case Token of
'+':
Begin
NextToken;
EvalItem(aBuffer);
aValue += aBuffer
End;
'-':
Begin
NextToken;
EvalItem(aBuffer);
aValue := -aBuffer;
End;
Else
Begin
EvalItem(aBuffer);
aValue := aBuffer;
End;
End;
End;
Procedure TExpressionParser.EvalTerm(Var aValue: Double);
Var
aBuffer: Double = 0;
Begin
EvalFactor(aBuffer);
aValue := aBuffer;
If SkipToken('*') Then
Begin
EvalTerm(aBuffer);
aValue *= aBuffer;
End
Else
If SkipToken('/') Then
Begin
EvalTerm(aBuffer);
aValue /= aBuffer;
End;
End;
Procedure TExpressionParser.EvalExpr(Var aValue: Double);
Var
aBuffer: Double = 0;
begin
EvalTerm(aBuffer);
aValue := aBuffer;
If SkipToken('+') Then
Begin
EvalExpr(aBuffer);
aValue += aBuffer;
End
Else
If SkipToken('-') Then
Begin
EvalExpr(aBuffer);
aValue -= aBuffer;
End
end;
Procedure TExpressionParser.SetX(Const aX: Double);
Begin
bX := aX;
End;
Procedure TExpressionParser.SetY(Const aY: Double);
Begin
bY := aY;
End;
end.
- Код: Выделить всё
program project1;
{$mode objfpc}{$H+}
uses
sysutils, Classes, ExpressionParser;
Var
i: Integer;
aBuffer: Double;
aDate: TDateTime;
aStream: TStringStream;
aParser: TExpressionParser;
begin
aDate := Now;
aStream := TStringStream.Create('If((x*2.33)>y)Then(' +
'If(y - 5>0)Then(x* 1.33 + 1)Else((y * 1.33 + 1 + 20)/(x*y)))Else(y*5.44)+11+(x+y)/(x*y)');
aStream.Position := 0;
aParser := TExpressionParser.Create(aStream);
For i := 0 To 1000000 Do
Begin
aStream.Position := 0;
aParser.SetX(Random(10) + 1);
aParser.SetY(Random(10) + 1);
aParser.EvalExpr(aBuffer);
//WriteLn(aBuffer:0:2);
End;
aParser.Free;
aStream.Free;
WriteLn('VALUE :: ', aBuffer:0:2); //VALUE :: 10.31
WriteLn(FormatDateTime('ss:zz', Now - aDate)); //34:612
end.
