paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 03:11:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Dmitry Boyarintsev to implement expression parsing. Improved to have operator as enumerated

Browse Source 
git-svn-id: trunk@15559 -
This commit is contained in:
michael 2010-07-12 20:56:43 +00:00
parent 3719524cb0
commit 56d3739a03
2 changed files with 380 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
packages/fcl-passrc/src/pastree.pp
View File

@ -67,6 +67,37 @@ resourcestring
SPasTreeDestructorImpl = 'destructor implementation';
type
TPasExprKind = (pekIdent, pekNumber, pekString, pekSet,
pekPrefix, pekPostfix, pekBinary, pekFuncParams, pekArrayParams);
TExprOpCode = (eopNone,
eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
eopShr,eopSHl, // bit operations
eopNot,eopAnd,eopOr,eopXor, // logical/bit
eopEqual, eopNotEqual, // Logical
eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
eopAddress);
{ TPasExprPart }
TPasExprPart = class
Kind : TPasExprKind;
Left : TPasExprPart;
Right : TPasExprPart;
OpCode : TexprOpcode;
Value : AnsiString;
Params : array of TPasExprPart;
constructor Create(AKind: TPasExprKind);
constructor CreateWithText(AKind: TPasExprKind; const AValue : Ansistring);
constructor CreatePrefix(rightExp: TPasExprPart; const AOpCode: TExprOpCode);
constructor CreatePostfix(leftExp: TPasExprPart; const AOpCode: TExprOpCode);
constructor CreateBinary(xleft, xright: TPasExprPart; const AOpCode: TExprOpCode);
destructor Destroy; override;
procedure AddParam(xp: TPasExprPart);
end;
// Visitor pattern.
TPassTreeVisitor = class;
@ -436,6 +467,7 @@ type
Value: string;
Modifiers : string;
AbsoluteLocation : String;
Expr: TPasExprPart;
end;
{ TPasConst }
@ -2283,4 +2315,60 @@ begin
Result:=true;
end;
{ TPasExprPart }
constructor TPasExprPart.Create(AKind:TPasExprKind);
begin
Kind:=AKind;
end;
constructor TPasExprPart.CreateWithText(AKind:TPasExprKind;const AValue: AnsiString);
begin
Create(AKind);
Value:=AValue;
end;
constructor TPasExprPart.CreatePrefix(rightExp: TPasExprPart; const AOpCode: TExprOpCode);
begin
Create(pekPrefix);
right:=rightExp;
Opcode:=AOpCode;
end;
constructor TPasExprPart.CreatePostfix(leftExp: TPasExprPart; const AOpCode: TExprOpCode);
begin
Create(pekPostfix);
left:=leftExp;
Opcode:=AOpCode;
end;
constructor TPasExprPart.CreateBinary(xleft, xright: TPasExprPart; const AOpCode: TExprOpcode);
begin
Create(pekBinary);
left:=xleft;
right:=xright;
Opcode:=AOpCode;
end;
destructor TPasExprPart.Destroy;
var
i : Integer;
begin
left.Free;
right.Free;
for i:=0 to length(Params)-1 do Params[i].Free;
inherited Destroy;
end;
procedure TPasExprPart.AddParam(xp:TPasExprPart);
var
i : Integer;
begin
i:=Length(Params);
SetLength(Params, i+1);
Params[i]:=xp;
end;
end.

299
packages/fcl-passrc/src/pparser.pp
View File

@ -80,7 +80,6 @@ type
property Column: Integer read FColumn;
end;
function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
@ -115,12 +114,17 @@ type
FTokenBufferSize: Integer; // maximum valid index in FTokenBuffer
procedure ParseExc(const Msg: String);
protected
function OpLevel(t: TToken): Integer;
Function TokenToExprOp (AToken : TToken; Const AString : String) : TExprOpCode;
function CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement): TPasElement;overload;
function CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload;
Function IsHint(Const S : String; AHint : TPasMemberHint) : Boolean;
Function IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
function ParseParams(paramskind: TPasExprKind): TPasExprPart;
function ParseExpIdent: TPasExprPart;
public
Options : set of TPOptions;
CurModule: TPasModule;
@ -138,6 +142,7 @@ type
function ParseComplexType(Parent : TPasElement = Nil): TPasType;
procedure ParseArrayType(Element: TPasArrayType);
procedure ParseFileType(Element: TPasFileType);
function DoParseExpression: TPasExprPart;
function ParseExpression: String;
function ParseCommand: String; // single, not compound command like begin..end
procedure AddProcOrFunction(Declarations: TPasDeclarations; AProc: TPasProcedure);
@ -181,7 +186,6 @@ type
property CurTokenString: String read FCurTokenString;
end;
function TPasTreeContainer.CreateElement(AClass: TPTreeElement;
const AName: String; AParent: TPasElement; const ASourceFilename: String;
ASourceLinenumber: Integer): TPasElement;
@ -334,7 +338,7 @@ begin
Result:=ParseType(Parent,'');
end;
Function TPasParser.IsHint(Const S : String; AHint : TPasMemberHint) : Boolean;
Function TPasParser.IsHint(Const S : String; var AHint : TPasMemberHint) : Boolean;
Var
T : string;
@ -635,6 +639,278 @@ begin
Element.ElType := ParseType(nil);
end;
const
EndExprToken = [
tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon,
tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
];
function TPasParser.ParseParams(paramskind: TPasExprKind): TPasExprPart;
var
params : TPasExprPart;
p : TPasExprPart;
PClose : TToken;
begin
Result:=nil;
if CurToken<>tkBraceOpen then Exit;
if paramskind in [pekArrayParams, pekSet] then
PClose:=tkSquaredBraceClose
else
PClose:=tkBraceClose;
params:=TPasExprPart.Create(paramskind);
try
NextToken;
if not (CurToken in EndExprToken) then begin
repeat
p:=DoParseExpression;
if not Assigned(p) then Exit; // bad param syntax
params.AddParam(p);
if not (CurToken in [tkComma, PClose]) then begin
Exit;
end;
if CurToken = tkComma then begin
NextToken;
if CurToken = PClose then begin
//ErrorExpected(parser, 'identifier');
Exit;
end;
end;
until CurToken=PClose;
end;
NextToken;
Result:=params;
finally
if not Assigned(Result) then params.Free;
end;
end;
Function TPasParser.TokenToExprOp (AToken : TToken; Const AString : String) : TExprOpCode;
begin
Case AToken of
tkMul : Result:=eopMultiply;
tkPlus : Result:=eopAdd;
tkMinus : Result:=eopSubtract;
tkDivision : Result:=eopDivide;
tkLessThan : Result:=eopLessThan;
tkEqual : Result:=eopEqual;
tkGreaterThan : Result:=eopGreaterThan;
tkAt : Result:=eopAddress;
tkNotEqual : Result:=eopNotEqual;
tkLessEqualThan : Result:=eopLessthanEqual;
tkGreaterEqualThan : Result:=eopGreaterThanEqual;
tkPower : Result:=eopPower;
tkSymmetricalDifference : Result:=eopSymmetricalDifference;
tkIs : Result:=eopIs;
tkAs : Result:=eopAs;
tkSHR : Result:=eopSHR;
tkSHL : Result:=eopSHL;
tkAnd : Result:=eopAnd;
tkOr : Result:=eopOR;
tkXor : Result:=eopXOR;
tkMod : Result:=eopMod;
tkDiv : Result:=eopDiv;
tkNot : Result:=eopNot;
tkIn : Result:=eopIn;
else
Raise Exception.CreateFmt('Not an operand: (%d : %s)',[AToken,Astring]);
end;
end;
function TPasParser.ParseExpIdent:TPasExprPart;
var
x, t : TPasExprPart;
eofid : Boolean;
begin
Result:=nil;
eofid:=True;
case CurToken of
tkString: begin
x:=TPasExprPart.CreateWithText(pekString, CurTokenString);
NextToken;
end;
tkNumber:
begin
x:=TPasExprPart.CreateWithText(pekNumber, CurTokenString);
NextToken;
end;
tkSquaredBraceOpen:
x:=ParseParams(pekSet);
tkIdentifier: begin
x:=TPasExprPart.CreateWithText(pekIdent, CurTokenText);
eofid:=False;
end;
end;
if eofid then begin
Result:=x;
Exit;
end;
try
NextToken;
while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
case CurToken of
tkBraceOpen: begin
t:=ParseParams(pekFuncParams);
if not Assigned(t) then Exit;
t.left:=x;
x:=t;
end;
tkSquaredBraceOpen: begin
t:=ParseParams(pekArrayParams);
if not Assigned(t) then Exit;
t.left:=x;
x:=t;
end;
tkCaret: begin
t:=TPasExprPart.CreatePostfix(x, TokenToExprOp(CurToken,TokenInfos[CurToken]));
NextToken;
x:=t;
end;
end;
if CurToken in [tkDot, tkas] then begin
NextToken;
x:=TPasExprPart.CreateBinary(x, ParseExpIdent, TokenToExprOp(CurToken,TokenInfos[CurToken]));
if not Assigned(x.right) then
Exit; // error?
end;
Result:=x;
finally
if not Assigned(Result) then x.Free;
end;
end;
function TPasParser.OpLevel(t: TToken): Integer;
begin
case t of
tknot,tkAt:
Result:=4;
tkMul, tkDivision, tkdiv, tkmod, tkand, tkShl,tkShr, tkas, tkPower :
Result:=3;
tkPlus, tkMinus, tkor, tkxor:
Result:=2;
tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan, tkGreaterThan, tkGreaterEqualThan, tkin, tkis:
Result:=1;
else
Result:=0;
end;
end;
function TPasParser.DoParseExpression: TPasExprPart;
var
expstack : TList;
opstack : TList;
pcount : Integer;
x : TPasExprPart;
i : Integer;
tempop : TToken;
const
PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @
function PopExp: TPasExprPart; inline;
begin
if expstack.Count>0 then begin
Result:=TPasExprPart(expstack[expstack.Count-1]);
expstack.Delete(expstack.Count-1);
end else
Result:=nil;
end;
procedure PushOper(token: TToken); inline;
begin
opstack.Add( Pointer(PtrInt(token)) );
end;
function PeekOper: TToken; inline;
begin
if opstack.Count>0 then Result:=TToken(PtrUInt(opstack[ opstack.Count-1]))
else Result:=tkEOF
end;
function PopOper: TToken; inline;
begin
Result:=PeekOper;
if Result<>tkEOF then opstack.Delete(opstack.Count-1);
end;
procedure PopAndPushOperator;
var
t : TToken;
xright : TPasExprPart;
xleft : TPasExprPart;
begin
t:=PopOper;
xright:=PopExp;
xleft:=PopExp;
expstack.Add(TPasExprPart.CreateBinary(xleft, xright, TokenToExprOp(t,TokenInfos[t])));
end;
begin
Result:=nil;
expstack := TList.Create;
opstack := TList.Create;
try
repeat
pcount:=0;
while CurToken in PrefixSym do begin
PushOper(CurToken);
inc(pcount);
NextToken;
end;
if CurToken = tkBraceOpen then begin
NextToken;
x:=DoParseExpression();
if CurToken<>tkBraceClose then Exit;
NextToken;
end else
x:=ParseExpIdent;
if not Assigned(x) then Exit;
expstack.Add(x);
for i:=1 to pcount do
begin
tempop:=PopOper;
expstack.Add( TPasExprPart.CreatePrefix( PopExp, TokenToExprOp(tempop,TokenInfos[tempop]) ));
end;
if not (CurToken in EndExprToken) then begin
// Adjusting order of the operations
tempop:=PeekOper;
while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
PopAndPushOperator;
tempop:=PeekOper;
end;
PushOper(CurToken);
NextToken;
end;
until CurToken in EndExprToken;
while opstack.Count>0 do PopAndPushOperator;
// only 1 expression should be on the stack, at the end of the correct expression
if expstack.Count=1 then Result:=TPasExprPart(expstack[0]);
finally
if not Assigned(Result) then begin
// expression error!
for i:=0 to expstack.Count-1 do
TObject(expstack[i]).Free;
end;
opstack.Free;
expstack.Free;
end;
end;
function TPasParser.ParseExpression: String;
var
BracketLevel: Integer;
@ -672,7 +948,7 @@ begin
if CurToken=tkString then
begin
If (Length(CurTokenText)>0) and (CurTokenText[1]=#0) then
Writeln('First char is null : "',CurTokenText,'"');
Raise Exception.Create('First char is null : "'+CurTokenText+'"');
Result := Result + ''''+StringReplace(CurTokenText,'''','''''',[rfReplaceAll])+''''
end
else
@ -1149,7 +1425,6 @@ end;
function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst;
begin
Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent));
try
NextToken;
if CurToken = tkColon then
@ -1158,7 +1433,17 @@ begin
UngetToken;
ExpectToken(tkEqual);
Result.Value := ParseExpression;
//skipping the expression as a value
//Result.Value := ParseExpression;
// using new expression parser!
NextToken; // skip tkEqual
Result.Expr:=DoParseExpression;
// must unget for the check to be peformed fine!
UngetToken;
CheckHint(Result,True);
except
Result.Free;