1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-29 20:32:18 -05:00
Simba/Units/Misc/CastaliaSimplePasPar.pas

5956 lines
123 KiB
ObjectPascal
Raw Normal View History

2010-03-26 17:21:07 -04:00
{---------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with the
License. You may obtain a copy of the License at
http://www.mozilla.org/NPL/NPL-1_1Final.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: mwSimplePasPar.pas, released November 14, 1999.
The Initial Developer of the Original Code is Martin Waldenburg
(Martin.Waldenburg@T-Online.de).
Portions created by Martin Waldenburg are Copyright (C) 1998, 1999 Martin
Waldenburg.
All Rights Reserved.
Portions CopyRight by Robert Zierer.
Contributor(s): James Jacobson, Dean Hill, Vladimir Churbanov___________________.
Last Modified: 2002/01/16
Current Version: 1.02
Notes: This program is an early beginning of a Pascal parser.
I'd like to invite the Delphi community to develop it further and to create
a fully featured Object Pascal parser.
Modification history:
Jacob Thurman between 20040301 and 20020401
Made ready for Delphi 8:
Added new directives and keywords: static, sealed, final, operator, unsafe.
Added parsing for custom attributes (based on ECMA C# specification).
Added support for nested types in class declarations.
Jeff Rafter between 20020116 and 20020302
Added AncestorId and AncestorIdList back in, but now treat them as Qualified
Identifiers per Daniel Rolf's fix. The separation from QualifiedIdentifierList
is need for descendent classes.
Added VarName and VarNameList back in for descendent classes, fixed to correctly
use Identifiers as in Daniel's verison
Removed fInJunk flags (they were never used, only set)
Pruned uses clause to remove windows dependency. This required changing
"TPoint" to "TTokenPoint". TTokenPoint was declared in mwPasLexTypes
Daniel Rolf between 20010723 and 20020116
Made ready for Delphi 6
ciClassClass for "class function" etc.
ciClassTypeEnd marks end of a class declaration (I needed that for the delphi-objectif-connector)
ciEnumeratedTypeItem for items of enumerations
ciDirectiveXXX for the platform, deprecated, varargs, local
ciForwardDeclaration for "forward" (until now it has been read but no event)
ciIndexSpecifier for properties
ciObjectTypeEnd marks end of an object declaration
ciObjectProperty property for objects
ciObjectPropertySpecifiers property for objects
ciPropertyDefault marking default of property
ciDispIDSpecifier for dispid
patched some functions for implementing the above things and patching the following bugs/improv.:
ObjectProperty handling overriden properties
ProgramFile, UnitFile getting Identifier instead of dropping it
InterfaceHeritage: Qualified identifiers
bugs in variant records
typedconstant failed with complex set constants. simple patch using ConstantExpression
German localization for the two string constants. Define GERMAN for german string constants.
Greg Chapman on 20010522
Better handling of defaut array property
Separate handling of X and Y in property Pixels[X, Y: Integer through identifier "event"
corrected spelling of "ForwardDeclaration"
James Jacobson on 20010223
semi colon before finalization fix
James Jacobson on 20010223
RecordConstant Fix
Martin waldenburg on 2000107
Even Faster lexer implementation !!!!
James Jacobson on 20010107
Improper handling of the construct
property TheName: Integer read FTheRecord.One.Two; (stop at second point)
where one and two are "qualifiable" structures.
James Jacobson on 20001221
Stops at the second const.
property Anchor[const Section: string; const Ident:string]: string read
changed TmwSimplePasPar.PropertyParameterList
On behalf of Martin Waldenburg and James Jacobson
Correction in array property Handling (Matin and James) 07/12/2000
Use of ExId instead of TokenId in ExportsElements (James) 07/12/2000
Reverting to old behavior in Statementlist [tokintegerConst put back in] (James) 07/12/2000
Xavier Masson InnerCircleProject : XM : 08/11/2000
Integration of the new version delivered by Martin Waldenburg with the modification I made described just below
Xavier Masson InnerCircleProject : XM : 07/15/2000
Added "states/events " for spaces( SkipSpace;) CRLFco (SkipCRLFco) and
CRLF (SkipCRLF) this way the parser can give a complete view on code allowing
"perfect" code reconstruction.
(I fully now that this is not what a standard parser will do but I think it is more usefull this way ;) )
go to www.innercircleproject.com for more explanations or express your critisism ;)
previous modifications not logged sorry ;)
Known Issues:
-----------------------------------------------------------------------------}
{----------------------------------------------------------------------------
Last Modified: 05/22/2001
Current Version: 1.1
official version
Maintained by InnerCircle
http://www.innercircleproject.org
02/07/2001
added property handling in Object types
changed handling of forward declarations in ExportedHeading method
-----------------------------------------------------------------------------}
unit CastaliaSimplePasPar;
{$include ValistusDefines.inc}
interface
uses
//!! pruned uses
SysUtils,
Classes,
CastaliaPasLexTypes,
CastaliaPasLex,
CastaliaSimplePasParTypes;
resourcestring
rsExpected = '''%s'' expected found ''%s''';
rsEndOfFile = 'end of file';
const
ClassMethodDirectiveEnum = [tokAbstract, tokCdecl, tokDynamic, tokMessage, tokOverride,
tokOverload, tokPascal, tokRegister, tokReintroduce, tokSafeCall, tokStdCall,
tokVirtual,
tokDeprecated, tokLibrary, tokPlatform // DR 2001-10-20
{$IFDEF D8_NEWER}
, tokStatic //JThurman 2004-11-10
{$ENDIF}
{$IFDEF D9_NEWER}
, tokInline
{$ENDIF}
]; //XM 2002-01-29
type
ESyntaxError = class(Exception)
private //jdj 7/18/1999
FPosXY: TTokenPoint;
protected
public
constructor Create(const Msg: string);
constructor CreateFmt(const Msg: string; const Args: array of const);
constructor CreatePos(const Msg: string; aPosXY: TTokenPoint);
property PosXY: TTokenPoint read FPosXY write FPosXY;
end;
type
TmwSimplePasPar = class(TObject)
private
fOnMessage: TMessageEvent;
fLexer: TmwPasLex;
fInterfaceOnly: Boolean;
fLastNoJunkPos: Integer;
fLastNoJunkLen: Integer;
AheadParse: TmwSimplePasPar;
procedure InitAhead;
protected
fInRound: Boolean;
procedure Expected(Sym: TptTokenKind); virtual;
procedure ExpectedEx(Sym: TptTokenKind); virtual;
procedure ExpectedFatal(Sym: TptTokenKind); virtual;
procedure HandlePtCompDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtDefineDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtElseDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtEndIfDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtIfDefDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtIfNDefDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtIfOptDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtIncludeDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtResourceDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtUndefDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtIfDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtIfEndDirect(Sender: TmwBasePasLex); virtual;
procedure HandlePtElseIfDirect(Sender: TmwBasePasLex); virtual;
procedure NextToken; virtual;
procedure SkipJunk; virtual;
procedure TerminateStream(Stream: TCustomMemoryStream); virtual;
procedure SEMICOLON; virtual;
function GetExID: TptTokenKind; virtual;
function GetTokenID: TptTokenKind; virtual;
function GetGenID: TptTokenKind; virtual;
procedure AccessSpecifier; virtual;
procedure AdditiveOperator; virtual;
procedure AncestorIdList; virtual; // !! Added ancestorIdList back in...
procedure AncestorId; virtual; // !! Added ancestorId back in...
procedure AnonymousMethod; virtual;
procedure AnonymousMethodType; virtual;
procedure ArrayConstant; virtual;
procedure ArrayType; virtual;
procedure AsmStatement; virtual;
procedure Block; virtual;
procedure CaseLabel; virtual;
procedure CaseSelector; virtual;
procedure CaseStatement; virtual;
procedure CharString; virtual;
procedure ClassField; virtual;
procedure ClassForward; virtual;
procedure ClassFunctionHeading; virtual;
procedure ClassHeritage; virtual;
procedure ClassMemberList; virtual;
procedure ClassMethodDirective; virtual;
procedure ClassMethodHeading; virtual;
procedure ClassMethodOrProperty; virtual;
procedure ClassMethodResolution; virtual;
procedure ClassProcedureHeading; virtual;
procedure ClassClass; virtual;
procedure ClassProperty; virtual;
procedure ClassReferenceType; virtual;
procedure ClassType; virtual;
procedure ClassTypeEnd; virtual; // DR 2001-07-31
procedure ClassVisibility; virtual;
procedure CompoundStatement; virtual;
procedure ConstantColon; virtual;
procedure ConstantDeclaration; virtual;
procedure ConstantEqual; virtual;
procedure ConstantExpression; virtual;
procedure ConstantName; virtual;
//JR added constant type
procedure ConstantType; virtual;
procedure ConstantValue; virtual;
procedure ConstantValueTyped; virtual;
procedure ConstParameter; virtual;
procedure ConstructorHeading; virtual;
procedure ConstructorName; virtual;
procedure ConstSection; virtual;
procedure ContainsClause; virtual;
procedure ContainsExpression; virtual;
procedure ContainsIdentifier; virtual;
procedure ContainsStatement; virtual;
{$IFDEF D8_NEWER}
procedure CustomAttribute; virtual; //JThurman 2004-03-03
{$ENDIF}
procedure DeclarationSection; virtual;
procedure Designator; virtual;
procedure DestructorHeading; virtual;
procedure DestructorName; virtual;
procedure Directive16Bit; virtual;
procedure DirectiveBinding; virtual;
procedure DirectiveCalling; virtual;
procedure DirectiveDeprecated; virtual; // DR 2001-10-20
procedure DirectiveLibrary; virtual; // DR 2001-10-20
procedure DirectiveLocal; virtual; // DR 2001-11-14
procedure DirectivePlatform; virtual; // DR 2001-10-20
procedure DirectiveVarargs; virtual; // DR 2001-11-14
procedure DispInterfaceForward; virtual;
procedure DispIDSpecifier; virtual; // DR 2001-07-26
procedure EmptyStatement; virtual;
procedure EnumeratedType; virtual;
procedure EnumeratedTypeItem; virtual; // DR 2001-10-29
procedure ExceptBlock; virtual;
procedure ExceptionBlockElseBranch; virtual;
procedure ExceptionClassTypeIdentifier; virtual;
procedure ExceptionHandler; virtual;
procedure ExceptionHandlerList; virtual;
procedure ExceptionIdentifier; virtual;
procedure ExceptionVariable; virtual;
procedure ExplicitType; virtual; // !! changed spelling to "Explicit"
procedure ExportedHeading; virtual;
procedure ExportsClause; virtual;
procedure ExportsElement; virtual;
procedure Expression; virtual;
procedure ExpressionList; virtual;
procedure ExternalDirective; virtual;
procedure ExternalDirectiveThree; virtual;
procedure ExternalDirectiveTwo; virtual;
procedure Factor; virtual;
procedure FieldDeclaration; virtual;
procedure FieldList; virtual;
procedure FieldNameList; virtual;
procedure FieldName; virtual;
procedure FileType; virtual;
procedure FormalParameterList; virtual;
procedure FormalParameterSection; virtual;
procedure ForStatement; virtual;
procedure ForwardDeclaration; virtual; {GLC: corrected spelling}
procedure FunctionHeading; virtual;
procedure FunctionMethodDeclaration; virtual;
procedure FunctionMethodName; virtual;
procedure FunctionProcedureBlock; virtual;
procedure FunctionProcedureName; virtual;
procedure Identifier; virtual;
procedure IdentifierList; virtual;
procedure IfStatement; virtual;
procedure ImplementationSection; virtual;
procedure IncludeFile; virtual;
procedure IndexSpecifier; virtual; // DR 2001-07-26
procedure InheritedStatement; virtual;
procedure InitializationSection; virtual;
procedure InlineStatement; virtual;
procedure InParameter; virtual;
procedure InterfaceDeclaration; virtual;
procedure InterfaceForward; virtual;
procedure InterfaceGUID; virtual;
procedure InterfaceHeritage; virtual;
procedure InterfaceMemberList; virtual;
procedure InterfaceSection; virtual;
procedure InterfaceType; virtual;
procedure LabelDeclarationSection; virtual;
procedure LabeledStatement; virtual;
procedure LabelId; virtual;
procedure LibraryFile; virtual;
procedure MainUsedUnitExpression; virtual;
procedure MainUsedUnitName; virtual;
procedure MainUsedUnitStatement; virtual;
procedure MainUsesClause; virtual;
procedure MultiplicativeOperator; virtual;
procedure NewFormalParameterType; virtual;
procedure Number; virtual;
procedure ObjectConstructorHeading; virtual;
procedure ObjectDestructorHeading; virtual;
procedure ObjectField; virtual;
procedure ObjectForward; virtual;
procedure ObjectFunctionHeading; virtual;
procedure ObjectHeritage; virtual;
procedure ObjectMemberList; virtual;
procedure ObjectMethodDirective; virtual;
procedure ObjectMethodHeading; virtual;
procedure ObjectNameOfMethod; virtual;
procedure ObjectProperty; virtual;
procedure ObjectPropertySpecifiers; virtual;
procedure ObjectProcedureHeading; virtual;
procedure ObjectType; virtual;
procedure ObjectTypeEnd; virtual; // DR 2001-08-07
procedure ObjectVisibility; virtual;
procedure OldFormalParameterType; virtual;
procedure OrdinalIdentifier; virtual;
procedure OrdinalType; virtual;
procedure OutParameter; virtual;
procedure PackageFile; virtual;
procedure ParameterFormal; virtual;
procedure ParameterName; virtual;
procedure ParameterNameList; virtual;
procedure ParseFile; virtual;
procedure PointerType; virtual;
procedure ProceduralDirective; virtual;
procedure ProceduralType; virtual;
procedure ProcedureDeclarationSection; virtual;
procedure ProcedureHeading; virtual;
procedure ProcedureMethodDeclaration; virtual;
procedure ProcedureMethodName; virtual;
procedure ProgramBlock; virtual;
procedure ProgramFile; virtual;
procedure PropertyDefault; virtual;
procedure PropertyInterface; virtual;
procedure PropertyName; virtual;
procedure PropertyParameterConst; virtual;
procedure PropertyParameterList; virtual;
procedure PropertySpecifiers; virtual;
procedure QualifiedIdentifier; virtual;
procedure QualifiedIdentifierList; virtual;
procedure RaiseStatement; virtual;
procedure ReadAccessIdentifier; virtual;
procedure RealIdentifier; virtual;
procedure RealType; virtual;
procedure RecordConstant; virtual;
procedure RecordFieldConstant; virtual;
procedure RecordType; virtual;
procedure RecordVariant; virtual;
procedure RelativeOperator; virtual;
procedure RepeatStatement; virtual;
procedure RequiresClause; virtual;
procedure RequiresIdentifier; virtual;
procedure ResolutionInterfaceName; virtual;
procedure ResourceDeclaration; virtual;
procedure ReturnType; virtual;
procedure SetConstructor; virtual;
procedure SetElement; virtual;
procedure SetType; virtual;
procedure SimpleExpression; virtual;
procedure SimpleStatement; virtual;
procedure SimpleType; virtual;
procedure SkipAnsiComment; virtual;
procedure SkipBorComment; virtual;
procedure SkipSlashesComment; virtual;
procedure SkipSpace; virtual; //XM Jul-2000
procedure SkipCRLFco; virtual; //XM Jul-2000
procedure SkipCRLF; virtual; //XM Jul-2000
procedure Statement; virtual;
procedure StatementList; virtual;
procedure StorageExpression; virtual;
procedure StorageIdentifier; virtual;
procedure StorageDefault; virtual;
procedure StorageNoDefault; virtual;
procedure StorageSpecifier; virtual;
procedure StorageStored; virtual;
procedure StringIdentifier; virtual;
procedure StringStatement; virtual;
procedure StringType; virtual;
procedure StructuredType; virtual;
procedure SubrangeType; virtual;
procedure TagField; virtual;
procedure TagFieldName; virtual;
procedure TagFieldTypeName; virtual;
procedure Term; virtual;
procedure TryStatement; virtual;
procedure TypedConstant; virtual;
procedure TypeDeclaration; virtual;
procedure TypeId; virtual;
procedure TypeKind; virtual;
procedure TypeName; virtual;
//generics
procedure TypeArgs; virtual;
procedure TypeParams; virtual;
procedure TypeParamDecl; virtual;
procedure TypeParamDeclList; virtual;
procedure TypeParamList; virtual;
procedure ConstraintList; virtual;
procedure Constraint; virtual;
//end generics
procedure TypeSection; virtual;
procedure UnitFile; virtual;
procedure UnitId; virtual;
procedure UnitName; virtual;
procedure UsedUnitName; virtual;
procedure UsedUnitsList; virtual;
procedure UsesClause; virtual;
procedure VarAbsolute; virtual;
procedure VarEqual; virtual;
procedure VarDeclaration; virtual;
procedure Variable; virtual;
procedure VariableList; virtual;
procedure VariableReference; virtual;
procedure VariableTwo; virtual;
procedure VariantIdentifier; virtual;
procedure VariantSection; virtual;
procedure VarParameter; virtual;
procedure VarName; virtual; //!! Added VarName and VarNameList back in...
procedure VarNameList; virtual;
procedure VarSection; virtual;
procedure VisibilityAutomated; virtual;
procedure VisibilityPrivate; virtual;
procedure VisibilityProtected; virtual;
procedure VisibilityPublic; virtual;
procedure VisibilityPublished; virtual;
procedure VisibilityUnknown; virtual;
procedure WhileStatement; virtual;
procedure WithStatement; virtual;
procedure WriteAccessIdentifier; virtual;
{$IFDEF D8_NEWER}//JThurman 2004-03-21
{This is the syntax for custom attributes, based quite strictly on the
ECMA syntax specifications for C#, but with a Delphi expression being
used at the bottom as opposed to a C# expression}
procedure GlobalAttributes;
procedure GlobalAttributeSections;
procedure GlobalAttributeSection;
procedure GlobalAttributeTargetSpecifier;
procedure GlobalAttributeTarget;
procedure Attributes;
procedure AttributeSections;
procedure AttributeSection;
procedure AttributeTargetSpecifier;
procedure AttributeTarget;
procedure AttributeList;
procedure Attribute;
procedure AttributeName;
procedure AttributeArguments;
procedure PositionalArgumentList;
procedure PositionalArgument;
procedure NamedArgumentList;
procedure NamedArgument;
procedure AttributeArgumentExpression;
{$ENDIF}
property ExID: TptTokenKind read GetExID;
property GenID: TptTokenKind read GetGenID;
property TokenID: TptTokenKind read GetTokenID;
public
constructor Create;
destructor Destroy; override;
procedure Assign(From: TObject); virtual;
procedure SynError(Error: TmwParseError); virtual;
procedure Run(SourceStream: TCustomMemoryStream; MaxPos: Integer = -1); virtual;
property InterfaceOnly: Boolean read fInterfaceOnly write fInterfaceOnly;
property Lexer: TmwPasLex read fLexer;
property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
property LastNoJunkPos: Integer read fLastNoJunkPos;
property LastNoJunkLen: Integer read fLastNoJunkLen;
published
end;
implementation
{ ESyntaxError }
constructor ESyntaxError.Create(const Msg: string);
begin
// !! changed initialization for TTokenPoint
FPosXY.X:= -1;
FPosXY.Y:= -1;
inherited Create(Msg);
end;
constructor ESyntaxError.CreateFmt(const Msg: string; const Args: array of const);
begin
// !! changed initialization for TTokenPoint
FPosXY.X:= -1;
FPosXY.Y:= -1;
inherited CreateFmt(Msg, Args);
end;
constructor ESyntaxError.CreatePos(const Msg: string; aPosXY: TTokenPoint);
begin
Message := Msg;
FPosXY := aPosXY;
end;
{ TmwSimplePasPar }
(* DR 2002-01-16
const
cnExpected = 'Expected ''%s'' found ''%s''';
// cnOrExpected = 'Expected ''%s'' or ''%s'' found ''%s''';
cnEndOfFile = 'end of file'; {jdj 7/22/1999}
// cnIntegerOverflow = 'Integer constant too large'; {jdj 7/22/1999}
*)
{range checks a tokIntegerConst-slightly faster than StrToInt}
{function IsValidInteger(const S: string): Boolean; jdj 7/22/1999
var jdj removed 02/07/2001
C: Integer;
N: Integer;
begin
Val(S, N, C);
Result := (C = 0);
end;}
procedure TmwSimplePasPar.ForwardDeclaration;
begin {jdj added method 02/07/2001}
NextToken;
SEMICOLON;
end;
procedure TmwSimplePasPar.ObjectProperty;
begin {jdj added method 02/07/2001}
// DR 2001-08-07 -> changed. for array-property override failure
Expected(tokProperty);
PropertyName;
case TokenID of
tokColon, tokSquareOpen:
begin
PropertyInterface;
end;
end;
ObjectPropertySpecifiers;
case ExID of
tokDefault:
begin
PropertyDefault; //DR 2001-07-16
SEMICOLON;
end;
end;
end;
procedure TmwSimplePasPar.ObjectPropertySpecifiers;
begin {jdj added method 02/07/2001}
if ExID = tokIndex then
begin
IndexSpecifier; // DR 2001-08-07
end;
while ExID in [tokRead, tokReadOnly, tokWrite, tokWriteOnly] do
begin
AccessSpecifier;
end;
while ExID in [tokDefault, tokNoDefault, tokStored] do
begin
StorageSpecifier;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.Run(SourceStream: TCustomMemoryStream; MaxPos: Integer = -1);
begin
TerminateStream(SourceStream);
fLexer.Origin := SourceStream.Memory;
fLexer.MaxPos := MaxPos;
ParseFile;
end;
constructor TmwSimplePasPar.Create;
begin
inherited Create;
fLexer := TmwPasLex.Create;
fLexer.OnCompDirect := {$IFDEF FPC}@{$ENDIF}HandlePtCompDirect;
fLexer.OnDefineDirect := {$IFDEF FPC}@{$ENDIF}HandlePtDefineDirect;
fLexer.OnElseDirect := {$IFDEF FPC}@{$ENDIF}HandlePtElseDirect;
fLexer.OnEndIfDirect := {$IFDEF FPC}@{$ENDIF}HandlePtEndIfDirect;
fLexer.OnIfDefDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfDefDirect;
fLexer.OnIfNDefDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfNDefDirect;
fLexer.OnIfOptDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfOptDirect;
fLexer.OnIncludeDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIncludeDirect;
fLexer.OnResourceDirect := {$IFDEF FPC}@{$ENDIF}HandlePtResourceDirect;
fLexer.OnUnDefDirect := {$IFDEF FPC}@{$ENDIF}HandlePtUndefDirect;
fLexer.OnIfDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfDirect;
fLexer.OnIfEndDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfEndDirect;
fLexer.OnElseIfDirect := {$IFDEF FPC}@{$ENDIF}HandlePtElseIfDirect;
end;
destructor TmwSimplePasPar.Destroy;
begin
FreeAndNil(AheadParse);
FreeAndNil(fLexer);
inherited;
end;
procedure TmwSimplePasPar.Assign(From: TObject);
begin
if (From is TmwSimplePasPar) then
with From as TmwSimplePasPar do
begin
Self.Lexer.CloneDefinesFrom(Lexer);
Self.OnMessage := OnMessage;
end;
end;
{next two check for tokNull and ExpectedFatal for an EOF Error}
procedure TmwSimplePasPar.Expected(Sym: TptTokenKind);
begin
if Sym <> Lexer.TokenID then
begin
if TokenID = tokNull then
ExpectedFatal(Sym) {jdj 7/22/1999}
else
begin
if Assigned(FOnMessage) then
FOnMessage(Self, meError, Format(rsExpected, [TokenName(Sym), fLexer.Token]),
fLexer.PosXY.X, fLexer.PosXY.Y);
end;
end
else
NextToken;
end;
procedure TmwSimplePasPar.ExpectedEx(Sym: TptTokenKind);
begin
if Sym <> Lexer.ExID then
begin
if Lexer.TokenID = tokNull then
ExpectedFatal(Sym) {jdj 7/22/1999}
else if Assigned(FOnMessage) then
FOnMessage(Self, meError, Format(rsExpected, ['EX:' + TokenName(Sym), fLexer.Token]),
fLexer.PosXY.X, fLexer.PosXY.Y);
end
else
NextToken;
end;
{Replace Token with cnEndOfFile if TokenId = toknull}
procedure TmwSimplePasPar.ExpectedFatal(Sym: TptTokenKind);
var
tS: string;
begin
if Sym <> Lexer.TokenID then
begin
{--jdj 7/22/1999--}
if Lexer.TokenId = tokNull then
tS := rsEndOfFile
else
tS := fLexer.Token;
{--jdj 7/22/1999--}
raise ESyntaxError.CreatePos(Format(rsExpected, [TokenName(Sym), tS]), fLexer.PosXY);
end
else
NextToken;
end;
procedure TmwSimplePasPar.HandlePtCompDirect(Sender: TmwBasePasLex);
begin
if Assigned(FOnMessage) then
FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y);
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtDefineDirect(Sender: TmwBasePasLex);
begin
Sender.Next; //XM Jul-2000
end;
procedure TmwSimplePasPar.HandlePtElseDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtElseIfDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next;
end;
procedure TmwSimplePasPar.HandlePtEndIfDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtIfDefDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtIfDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next;
end;
procedure TmwSimplePasPar.HandlePtIfEndDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next;
end;
procedure TmwSimplePasPar.HandlePtIfNDefDirect(Sender: TmwBasePasLex);
begin
if Sender = Lexer then
NextToken
else
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtIfOptDirect(Sender: TmwBasePasLex);
begin
if Assigned(FOnMessage) then
FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y);
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtIncludeDirect(Sender: TmwBasePasLex);
begin
if Assigned(FOnMessage) then
FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y);
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtResourceDirect(Sender: TmwBasePasLex);
begin
if Assigned(FOnMessage) then
FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y);
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.HandlePtUndefDirect(Sender: TmwBasePasLex);
begin
Sender.Next; //XM Jul-2000
{ ToDo }
end;
procedure TmwSimplePasPar.NextToken;
begin
FLexer.NextNoJunk;
end;
procedure TmwSimplePasPar.SkipJunk;
begin
if Lexer.IsJunk then
begin
case TokenID of
tokAnsiComment:
begin
SkipAnsiComment;
end;
tokBorComment:
begin
SkipBorComment;
end;
tokSlashesComment:
begin
SkipSlashesComment;
end;
tokSpace:
begin
SkipSpace; //XM Jul-2000
end;
tokCRLFCo:
begin
SkipCRLFco;
end;
tokCRLF:
begin
SkipCRLF;
end;
{$IFDEF D8_NEWER} //JThurman 2004-3-19
tokSquareOpen:
begin
CustomAttribute;
end;
{$ENDIF}
else
begin
Lexer.Next;
end;
end;
end;
fLastNoJunkPos := Lexer.TokenPos;
fLastNoJunkLen := Lexer.TokenLen;
end;
procedure TmwSimplePasPar.SkipAnsiComment;
begin
Expected(tokAnsiComment);
while TokenID in [tokAnsiComment] do
Lexer.Next;
end;
procedure TmwSimplePasPar.SkipBorComment;
begin
Expected(tokBorComment);
while TokenID in [tokBorComment] do
Lexer.Next;
end;
procedure TmwSimplePasPar.SkipSlashesComment;
begin
Expected(tokSlashesComment);
end;
procedure TmwSimplePasPar.TerminateStream(Stream: TCustomMemoryStream);
var
aChar: Char;
begin
Stream.Position := Stream.Size;
aChar := #0;
Stream.Write(aChar, SizeOf(char));
end;
procedure TmwSimplePasPar.SEMICOLON;
begin
case Lexer.TokenID of
tokElse, tokEnd, tokExcept, tokfinally, tokFinalization, tokRoundClose, tokUntil: // jdj 2.23.20001 added tokFinalization
;
else
Expected(tokSemiColon);
//Check for semicolon before else - common syntax error - JT 11.10.2007
//Doesn't work here - it fails a CASE statement
// if Lexer.TokenID = tokElse then
// begin
// if Assigned(FOnMessage) then
// begin
// FOnMessage(Self, meError, ''';'' not allowed before ''ELSE''',
// FLexer.PosXY.X, FLexer.PosXY.Y);
// end;
// end;
end;
end;
function TmwSimplePasPar.GetExID: TptTokenKind;
begin
Result := fLexer.ExID;
end;
function TmwSimplePasPar.GetTokenID: TptTokenKind;
begin
Result := fLexer.TokenID;
end;
function TmwSimplePasPar.GetGenID: TptTokenKind;
begin
Result := fLexer.GenID;
end;
procedure TmwSimplePasPar.SynError(Error: TmwParseError);
begin
if Assigned(FOnMessage) then
FOnMessage(Self, meError, ParserErrorName(Error) + ' found ' + fLexer.Token, fLexer.PosXY.X,
fLexer.PosXY.Y);
end;
(******************************************************************************
This part is oriented at the official grammar of Delphi 4
and parialy based on Robert Zierers Delphi grammar.
For more information about Delphi grammars take a look at:
http://www.stud.mw.tu-muenchen.de/~rz1/Grammar.html
******************************************************************************)
procedure TmwSimplePasPar.ParseFile;
//var
// I: Integer;
begin
// OutputDebugString('ParseFile');
SkipJunk;
case GenID of
tokLibrary:
begin
LibraryFile;
end;
tokPackage:
begin
PackageFile;
end;
tokProgram:
begin
ProgramFile;
end;
tokUnit:
begin
UnitFile;
end;
else
begin
IncludeFile;
end;
end;
end;
procedure TmwSimplePasPar.LibraryFile;
begin
Expected(tokLibrary);
Expected(tokIdentifier);
SEMICOLON;
ProgramBlock;
Expected(tokPoint);
end;
procedure TmwSimplePasPar.PackageFile;
begin
ExpectedEx(tokPackage);
Expected(tokIdentifier);
{$IFDEF D8_NEWER}
while Lexer.TokenID = tokPoint do
begin
NextToken;
Expected(tokIdentifier);
end;
{$ENDIF}
SEMICOLON;
case ExID of
tokRequires:
begin
RequiresClause;
end;
end;
case ExID of
tokContains:
begin
ContainsClause;
end;
end;
{$IFDEF D8_NEWER}
while Lexer.TokenID = tokSquareOpen do
begin
CustomAttribute;
end;
{$ENDIF}
Expected(tokEnd);
Expected(tokPoint);
end;
procedure TmwSimplePasPar.ProgramFile;
begin
// DR 2002-01-11
Expected(tokProgram);
QualifiedIdentifier;
if TokenID = tokRoundOpen then
begin
NextToken;
IdentifierList;
Expected(tokRoundClose);
end;
if not InterfaceOnly then
begin
SEMICOLON;
ProgramBlock;
Expected(tokPoint);
end;
end;
procedure TmwSimplePasPar.UnitFile;
begin
// DR 2002-01-11
//??
Expected(tokUnit);
UnitName;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
SEMICOLON;
InterfaceSection;
if not InterfaceOnly then
begin
ImplementationSection;
InitializationSection;
Expected(tokPoint);
end;
end;
procedure TmwSimplePasPar.ProgramBlock;
begin
if TokenID = tokUses then
begin
MainUsesClause;
end;
Block;
end;
procedure TmwSimplePasPar.MainUsesClause;
begin
Expected(tokUses);
MainUsedUnitStatement;
while TokenID = tokComma do
begin
NextToken;
MainUsedUnitStatement;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.MainUsedUnitStatement;
begin
MainUsedUnitName;
if Lexer.TokenID = tokIn then
begin
NextToken;
MainUsedUnitExpression;
end;
end;
procedure TmwSimplePasPar.MainUsedUnitName;
begin
// Expected(tokIdentifier);
UsedUnitName; //JThurman 2004-11-10
end;
procedure TmwSimplePasPar.MainUsedUnitExpression;
begin
ConstantExpression;
end;
procedure TmwSimplePasPar.UsesClause;
begin
Expected(tokUses);
UsedUnitsList;
SEMICOLON;
end;
procedure TmwSimplePasPar.UsedUnitsList;
begin
UsedUnitName;
while TokenID = tokComma do
begin
NextToken;
UsedUnitName;
end;
end;
procedure TmwSimplePasPar.UsedUnitName;
begin
{$IFDEF D8_NEWER} //JThurman 2004-03-03
Expected(tokIdentifier);
while TokenID = tokPoint do
begin
NextToken;
Expected(tokIdentifier);
end;
{$ELSE}
Expected(tokIdentifier);
{$ENDIF}
end;
procedure TmwSimplePasPar.Block;
begin
while TokenID in [tokClass, tokConst, tokConstructor, tokDestructor, tokExports,
tokFunction, tokLabel, tokProcedure, tokResourceString, tokThreadVar, tokType,
tokVar{$IFDEF D8_NEWER}, tokSquareOpen{$ENDIF}] do
begin
DeclarationSection;
end;
case TokenID of
tokAsm:
begin
AsmStatement;
end;
else
begin
CompoundStatement;
end;
end;
end;
procedure TmwSimplePasPar.DeclarationSection;
begin
case TokenID of
tokClass:
begin
ProcedureDeclarationSection;
end;
tokConst:
begin
ConstSection;
end;
tokConstructor:
begin
ProcedureDeclarationSection;
end;
tokDestructor:
begin
ProcedureDeclarationSection;
end;
tokExports:
begin
ExportsClause;
end;
tokFunction:
begin
ProcedureDeclarationSection;
end;
tokLabel:
begin
LabelDeclarationSection;
end;
tokProcedure:
begin
ProcedureDeclarationSection;
end;
tokResourceString:
begin
ConstSection;
end;
tokType:
begin
TypeSection;
end;
tokThreadVar:
begin
VarSection;
end;
tokVar:
begin
VarSection;
end;
{$IFDEF D8_NEWER} //JThurman
tokSquareOpen:
begin
CustomAttribute;
end;
{$ENDIF}
else
begin
SynError(InvalidDeclarationSection);
end;
end;
end;
procedure TmwSimplePasPar.UnitId;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.UnitName;
begin
Expected(tokIdentifier);
while Lexer.TokenID = tokPoint do
begin
NextToken;
Expected(tokIdentifier);
end;
end;
procedure TmwSimplePasPar.InterfaceHeritage;
begin
Expected(tokRoundOpen);
AncestorIdList; // JR moved qualified check into ancestorIdList // DR 2001-11-01 can also be qualified!
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.InterfaceGUID;
begin
Expected(tokSquareOpen);
CharString;
Expected(tokSquareClose);
end;
procedure TmwSimplePasPar.AccessSpecifier;
begin
case ExID of
tokRead:
begin
NextToken;
ReadAccessIdentifier;
end;
tokWrite:
begin
NextToken;
WriteAccessIdentifier;
end;
tokReadOnly:
begin
NextToken;
end;
tokWriteOnly:
begin
NextToken;
end;
{$IFDEF D8_NEWER}
tokAdd:
begin
NextToken;
QualifiedIdentifier; //TODO: AddAccessIdentifier
end;
tokRemove:
begin
NextToken;
QualifiedIdentifier; //TODO: RemoveAccessIdentifier
end;
{$ENDIF}
else
begin
SynError(InvalidAccessSpecifier);
end;
end;
end;
procedure TmwSimplePasPar.ReadAccessIdentifier;
begin
QualifiedIdentifier;
(* XM removed at Martin suggestion. Martin send a more general fix in QualifiedIdentifier
//jdj 12/05/2000
if (TokenID = tokSquareOpen) then
begin
ConstantExpression;
end;
//jdj 12/05/2000*)
end;
procedure TmwSimplePasPar.WriteAccessIdentifier;
begin
QualifiedIdentifier;
(* XM removed at Martin suggestion. Martin send a more general fix in QualifiedIdentifier
//jdj 12/05/2000
if (TokenID = tokSquareOpen) then
begin
ConstantExpression;
end;
//jdj 12/05/2000*)
end;
procedure TmwSimplePasPar.StorageSpecifier;
begin
case ExID of
tokStored:
begin
StorageStored;
end;
tokDefault:
begin
StorageDefault;
end;
tokNoDefault:
begin
StorageNoDefault;
end
else
begin
SynError(InvalidStorageSpecifier);
end;
end;
end;
procedure TmwSimplePasPar.StorageDefault;
begin
ExpectedEx(tokDefault);
StorageExpression;
end;
procedure TmwSimplePasPar.StorageNoDefault;
begin
ExpectedEx(tokNoDefault);
end;
procedure TmwSimplePasPar.StorageStored;
begin
ExpectedEx(tokStored);
case TokenID of
tokIdentifier:
begin
StorageIdentifier;
end;
else
if TokenID <> tokSemiColon then
begin
StorageExpression;
end;
end;
end;
procedure TmwSimplePasPar.StorageExpression;
begin
ConstantExpression;
end;
procedure TmwSimplePasPar.StorageIdentifier;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.PropertyParameterList;
//changed James Jacobson on 20001221
begin
Expected(tokSquareOpen);
if TokenID = tokConst then
begin
PropertyParameterConst;
end;
IdentifierList;
Expected(tokColon);
TypeId;
while TokenID = tokSemiColon do
begin
SEMICOLON;
if TokenID = tokConst then
begin //jdj 12-21-2000
PropertyParameterConst;
end;
IdentifierList;
Expected(tokColon);
TypeId;
end;
Expected(tokSquareClose);
end;
(*begin
Expected(tokSquareOpen);
if TokenID = tokConst then
begin
PropertyParameterConst;
end;
IdentifierList;
Expected(tokColon);
TypeId;
while TokenID = tokSemiColon do
begin
SEMICOLON;
IdentifierList;
Expected(tokColon);
TypeId;
end;
Expected(tokSquareClose);
end;*)
procedure TmwSimplePasPar.PropertyParameterConst;
begin
Expected(tokConst);
end;
procedure TmwSimplePasPar.PropertySpecifiers;
begin
if ExID = tokIndex then
begin
IndexSpecifier; // DR 2001-07-26
end;
while ExID in [tokRead, tokReadOnly, tokWrite, tokWriteOnly
{$IFDEF D8_NEWER}, tokAdd, tokRemove{$ENDIF}] do
begin
AccessSpecifier;
end;
if ExID = tokDispId then
begin
DispIDSpecifier; // DR 2001-07-26
end;
while ExID in [tokDefault, tokNoDefault, tokStored] do
begin
StorageSpecifier;
end;
if ExID = tokImplements then
begin
NextToken;
QualifiedIdentifierList;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.PropertyInterface;
begin
if TokenID = tokSquareOpen then
begin
PropertyParameterList;
end;
Expected(tokColon);
TypeID;
end;
procedure TmwSimplePasPar.ClassMethodHeading;
begin
case TokenID of
tokConstructor:
begin
ConstructorHeading;
end;
tokDestructor:
begin
DestructorHeading;
end;
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
tokFunction, tokIdentifier:
begin
if (TokenID = tokIdentifier) and (Lexer.ExID <> tokOperator) then
Expected(tokOperator);
{$ELSE}
tokFunction:
begin
{$ENDIF}
Lexer.InitAhead;
Lexer.AheadNext;
case Lexer.AheadTokenID of
tokPoint:
begin
ClassMethodResolution;
end;
else
begin
ClassFunctionHeading;
end;
end;
end;
tokProcedure:
begin
Lexer.InitAhead;
Lexer.AheadNext;
case Lexer.AheadTokenID of
tokPoint:
begin
ClassMethodResolution;
end;
else
begin
ClassProcedureHeading;
end;
end;
end;
else
SynError(InvalidClassMethodHeading);
end;
end;
procedure TmwSimplePasPar.ClassFunctionHeading;
begin
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
if (TokenID = tokIdentifier) and (Lexer.ExID = tokOperator) then
Expected(tokIdentifier) else
{$ENDIF}
Expected(tokFunction);
FunctionMethodName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
Expected(tokColon);
ReturnType;
if TokenId = tokSemicolon then // DR 2002-01-14
SEMICOLON;
if ExID = tokDispId then
begin
DispIDSpecifier; // DR 2001-07-26
if TokenId = tokSemicolon then // DR 2002-01-14
SEMICOLON;
end;
if ExID in ClassMethodDirectiveEnum //XM 2002-01-29
then ClassMethodDirective; //XM 2002-01-26
end;
procedure TmwSimplePasPar.FunctionMethodName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ClassProcedureHeading;
begin
Expected(tokProcedure);
ProcedureMethodName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
if TokenId = tokSemicolon then // DR 2002-01-14
SEMICOLON;
if ExID = tokDispId then
begin
DispIDSpecifier; // DR 2001-07-26
if TokenId = tokSemicolon then // DR 2002-01-14
SEMICOLON;
end;
if exID in ClassMethodDirectiveEnum then // XM 2002-01-29
ClassMethodDirective;
end;
procedure TmwSimplePasPar.ProcedureMethodName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ClassMethodResolution;
begin
case TokenID of
tokFunction:
begin
NextToken;
end;
tokProcedure:
begin
NextToken;
end;
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
tokIdentifier:
begin
if Lexer.ExID = tokOperator then
NextToken;
end;
{$ENDIF}
end;
ResolutionInterfaceName;
Expected(tokPoint);
Expected(tokIdentifier);
Expected(tokEqual);
Expected(tokIdentifier);
SEMICOLON;
end;
procedure TmwSimplePasPar.ResolutionInterfaceName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.Constraint;
begin
while TokenId in [tokConstructor, tokRecord, tokClass, tokIdentifier] do
begin
case TokenId of
tokConstructor, tokRecord, tokClass: NextToken;
tokIdentifier: TypeId;
end;
if TokenId = tokComma then
NextToken;
end;
end;
procedure TmwSimplePasPar.ConstraintList;
begin
Constraint;
while TokenId = tokComma do
begin
Constraint;
end;
end;
procedure TmwSimplePasPar.ConstructorHeading;
begin
Expected(tokConstructor);
ConstructorName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
SEMICOLON;
ClassMethodDirective;
end;
procedure TmwSimplePasPar.ConstructorName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.DestructorHeading;
begin
Expected(tokDestructor);
DestructorName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
SEMICOLON;
ClassMethodDirective;
end;
procedure TmwSimplePasPar.DestructorName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ClassMethodDirective;
begin
while ExId in ClassMethodDirectiveEnum do
begin
ProceduralDirective;
if TokenId = tokSemicolon then // DR 2002-01-14
SEMICOLON;
end;
end;
procedure TmwSimplePasPar.ObjectMethodHeading;
begin
case TokenID of
tokConstructor:
begin
ObjectConstructorHeading;
end;
tokDestructor:
begin
ObjectDestructorHeading;
end;
tokFunction:
begin
ObjectFunctionHeading;
end;
tokProcedure:
begin
ObjectProcedureHeading;
end;
else
begin
SynError(InvalidMethodHeading);
end;
end;
end;
procedure TmwSimplePasPar.ObjectFunctionHeading;
begin
Expected(tokFunction);
FunctionMethodName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
Expected(tokColon);
ReturnType;
if TokenID = tokSemiColon then SEMICOLON;
ObjectMethodDirective;
end;
procedure TmwSimplePasPar.ObjectProcedureHeading;
begin
Expected(tokProcedure);
ProcedureMethodName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
if TokenID = tokSemiColon then SEMICOLON;
ObjectMethodDirective;
end;
procedure TmwSimplePasPar.ObjectConstructorHeading;
begin
Expected(tokConstructor);
ConstructorName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
if TokenID = tokSemiColon then SEMICOLON;
ObjectMethodDirective;
end;
procedure TmwSimplePasPar.ObjectDestructorHeading;
begin
Expected(tokDestructor);
DestructorName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
if TokenID = tokSemiColon then SEMICOLON;
ObjectMethodDirective;
end;
procedure TmwSimplePasPar.ObjectMethodDirective;
begin
while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar,
tokMessage, tokNear,
tokOverload, // DR 2001-08-07
tokPascal, tokRegister, tokSafeCall, tokStdCall, tokVirtual,
tokDeprecated, tokLibrary, tokPlatform // DR 2001-10-20
{$IFDEF D8_NEWER}
, tokStatic
{$ENDIF}
{$IFDEF D9_NEWER}
, tokInline
{$ENDIF}
] do
begin
ProceduralDirective;
if TokenID = tokSemiColon then SEMICOLON;
end;
end;
procedure TmwSimplePasPar.Directive16Bit;
begin
case ExID of
tokNear:
begin
NextToken;
end;
tokFar:
begin
NextToken;
end;
tokExport:
begin
NextToken;
end;
else
begin
SynError(InvalidDirective16Bit);
end;
end;
end;
procedure TmwSimplePasPar.DirectiveBinding;
begin
case ExID of
tokVirtual:
begin
NextToken;
end;
tokDynamic:
begin
NextToken;
end;
tokMessage:
begin
NextToken;
ConstantExpression;
end;
tokOverride:
begin
NextToken;
end;
tokOverload:
begin
NextToken;
end;
tokReintroduce:
begin
NextToken;
end;
else
begin
SynError(InvalidDirectiveBinding);
end;
end;
end;
procedure TmwSimplePasPar.ReturnType;
begin
{$IFDEF D8_NEWER}
while TokenID = tokSquareOpen do
CustomAttribute;
{$ENDIF}
case TokenID of
tokString:
begin
StringType;
end;
else
begin
TypeID;
end;
end;
end;
procedure TmwSimplePasPar.FormalParameterList;
begin
Expected(tokRoundOpen);
FormalParameterSection;
while TokenID = tokSemiColon do
begin
SEMICOLON;
FormalParameterSection;
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.FormalParameterSection;
begin
{$IFDEF D8_NEWER}//JThurman 2004-03-23
while TokenID = tokSquareOpen do
CustomAttribute;
{$ENDIF}
case TokenID of
tokConst:
begin
ConstParameter;
end;
tokIdentifier:
case ExID of
tokOut: OutParameter;
else
ParameterFormal;
end;
tokIn:
begin
InParameter;
end;
tokVar:
begin
VarParameter;
end;
end;
end;
procedure TmwSimplePasPar.ConstParameter;
begin
Expected(tokConst);
ParameterNameList;
case TokenID of
tokColon:
begin
NextToken;
NewFormalParameterType;
if TokenID = tokEqual then
begin
NextToken;
TypedConstant;
end;
end
end;
end;
procedure TmwSimplePasPar.VarParameter;
begin
Expected(tokVar);
ParameterNameList;
case TokenID of
tokColon:
begin
NextToken;
NewFormalParameterType;
end
end;
end;
procedure TmwSimplePasPar.OutParameter;
begin
ExpectedEx(tokOut);
ParameterNameList;
case TokenID of
tokColon:
begin
NextToken;
NewFormalParameterType;
end
end;
end;
procedure TmwSimplePasPar.ParameterFormal;
begin
case TokenID of
tokIdentifier:
begin
ParameterNameList;
case TokenID of
tokColon:
begin
NextToken;
NewFormalParameterType;
if TokenID = tokEqual then
begin
NextToken;
TypedConstant;
end;
end
end;
{Expected(tokColon);
NewFormalParameterType;
if TokenID = tokEqual then
begin
NextToken;
TypedConstant;
end;}
end;
else
begin
SynError(InvalidParameter);
end;
end;
end;
procedure TmwSimplePasPar.ParameterNameList;
begin
ParameterName;
while TokenID = tokComma do
begin
NextToken;
ParameterName;
end;
end;
procedure TmwSimplePasPar.ParameterName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.NewFormalParameterType;
begin
case TokenID of
tokArray:
begin
NextToken;
Expected(tokOf);
case TokenID of
tokConst: (*new in ObjectPascal80*)
begin
NextToken;
end;
else
begin
OldFormalParameterType;
end;
end;
end;
else
begin
OldFormalParameterType;
end;
end;
end;
procedure TmwSimplePasPar.OldFormalParameterType;
begin
case TokenID of
tokString:
begin
NextToken;
end;
tokFile:
begin
FileType;
end;
else
begin
TypeID;
end;
end;
end;
procedure TmwSimplePasPar.FunctionMethodDeclaration;
begin
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
if (TokenID = tokIdentifier) and (Lexer.ExID = tokOperator) then
NextToken else
{$ENDIF}
Expected(tokFunction);
Lexer.InitAhead;
if Lexer.AheadTokenID in [tokPoint, tokLower] then
begin
ObjectNameOfMethod;
Expected(tokPoint);
end;
FunctionProcedureName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
case TokenID of
tokSemiColon:
begin
FunctionProcedureBlock;
end;
else
begin
Expected(tokColon);
ReturnType;
FunctionProcedureBlock;
end;
end;
end;
procedure TmwSimplePasPar.ProcedureMethodDeclaration;
begin
case TokenID of
tokConstructor:
begin
NextToken;
end;
tokDestructor:
begin
NextToken;
end;
tokProcedure:
begin
NextToken;
end;
else
begin
SynError(InvalidProcedureMethodDeclaration);
end;
end;
Lexer.InitAhead;
if Lexer.AheadTokenID in [tokPoint, tokLower] then
begin
ObjectNameOfMethod;
Expected(tokPoint);
end;
FunctionProcedureName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
FunctionProcedureBlock;
end;
procedure TmwSimplePasPar.FunctionProcedureName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ObjectNameOfMethod;
begin
Expected(tokIdentifier);
{$IFDEF D8_NEWER} //JThurman 2004-03-22
if TokenId = tokLower then
TypeParams;
Lexer.InitAHead;
Lexer.AheadNext;
if Lexer.AheadTokenID = tokPoint then
begin
Expected(tokPoint);
ObjectNameOfMethod;
end;
{$ENDIF}
end;
procedure TmwSimplePasPar.FunctionProcedureBlock;
var
NoExternal: Boolean;
begin
NoExternal := True;
if TokenID = tokSemiColon
then SEMICOLON;
case ExID of
tokForward:
ForwardDeclaration; // DR 2001-07-23
else
while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar,
tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister,
tokReintroduce, tokSafeCall, tokStdCall, tokVirtual,
tokDeprecated, tokLibrary, tokPlatform, // DR 2001-10-20
tokLocal, tokVarargs,
tokAssembler //JT 2004-10-29
{$IFDEF D8_NEWER}
, tokStatic
{$ENDIF}
{$IFDEF D9_NEWER}
, tokInline
{$ENDIF}
] // DR 2001-11-14
do
begin
case ExId of
tokExternal:
begin
ProceduralDirective;
if TokenID = tokSemiColon then SEMICOLON;
NoExternal := False;
end;
else
begin
ProceduralDirective;
if TokenID = tokSemiColon then SEMICOLON;
end;
end;
end;
if ExID = tokForward then
ForwardDeclaration // DR 2001-07-23
else if NoExternal then
begin
if ExId = tokAssembler then
begin
NextToken;
SEMICOLON;
end;
case TokenID of
tokAsm:
begin
AsmStatement;
end;
else
begin
Block;
end;
end;
SEMICOLON;
end;
end;
end;
procedure TmwSimplePasPar.ExternalDirective;
begin
ExpectedEx(tokExternal);
case TokenID of
tokSemiColon:
begin
SEMICOLON;
end;
else
begin
SimpleExpression;
ExternalDirectiveTwo;
end;
end;
end;
procedure TmwSimplePasPar.ExternalDirectiveTwo;
begin
case fLexer.ExID of
tokIndex:
begin
NextToken;
end;
tokName:
begin
NextToken;
SimpleExpression;
end;
tokSemiColon:
begin
SEMICOLON;
ExternalDirectiveThree;
end;
end
end;
procedure TmwSimplePasPar.ExternalDirectiveThree;
begin
case TokenID of
tokMinus:
begin
NextToken;
end;
end;
case TokenID of
tokIdentifier, tokIntegerConst:
begin
NextToken;
end;
end;
end;
procedure TmwSimplePasPar.ForStatement;
begin
Expected(tokFor);
QualifiedIdentifier;
{$IFDEF D8_NEWER}
if Lexer.TokenID = tokAssign then
begin
Expected(tokAssign);
Expression;
case TokenID of
tokTo:
begin
NextToken;
end;
tokDownTo:
begin
NextToken;
end;
else
begin
SynError(InvalidForStatement);
end;
end;
Expression;
end else
if Lexer.TokenID = tokIn then
begin
Expected(tokIn);
//QualifiedIdentifier;
Expression;
end;
{$ELSE}
Expected(tokAssign);
Expression;
case TokenID of
tokTo:
begin
NextToken;
end;
tokDownTo:
begin
NextToken;
end;
else
begin
SynError(InvalidForStatement);
end;
end;
Expression;
{$ENDIF}
Expected(tokDo);
Statement;
end;
procedure TmwSimplePasPar.WhileStatement;
begin
Expected(tokWhile);
Expression;
Expected(tokDo);
Statement;
end;
procedure TmwSimplePasPar.RepeatStatement;
begin
Expected(tokRepeat);
StatementList;
Expected(tokUntil);
Expression;
end;
procedure TmwSimplePasPar.CaseStatement;
begin
Expected(tokCase);
Expression;
Expected(tokOf);
CaseSelector;
while TokenID = tokSemiColon do
begin
SEMICOLON;
case TokenID of
tokElse, tokEnd: ;
else
CaseSelector;
end;
end;
if TokenID = tokElse then
begin
NextToken;
StatementList;
SEMICOLON;
end;
Expected(tokEnd);
end;
procedure TmwSimplePasPar.CaseSelector;
begin
CaseLabel;
while TokenID = tokComma do
begin
NextToken;
CaseLabel;
end;
Expected(tokColon);
case TokenID of
tokSemiColon: ;
else
Statement;
end;
end;
procedure TmwSimplePasPar.CaseLabel;
begin
ConstantExpression;
if TokenID = tokDotDot then
begin
NextToken;
ConstantExpression;
end;
end;
procedure TmwSimplePasPar.IfStatement;
begin
Expected(tokIf);
Expression;
Expected(tokThen);
Statement;
//This breaks if you have an if statement immediately preceding the else
//clause of a case statement
{ Lexer.InitAhead;
if (TokenID = tokSemicolon) and (Lexer.AheadTokenID = tokElse) then
begin
if Assigned(FOnMessage) then
begin
FOnMessage(Self, meError, ''';'' not allowed before ''ELSE''',
FLexer.PosXY.X, FLexer.PosXY.Y);
end;
end;}
if TokenID = tokElse then
begin
NextToken;
Statement;
end;
end;
procedure TmwSimplePasPar.ExceptBlock;
begin
case ExID of
tokOn:
begin
ExceptionHandlerList;
ExceptionBlockElseBranch
end;
else
begin
StatementList;
end;
end;
end;
procedure TmwSimplePasPar.ExceptionHandlerList;
begin
while fLexer.ExID = tokOn do
begin
ExceptionHandler;
SEMICOLON;
end;
end;
procedure TmwSimplePasPar.ExceptionHandler;
begin
ExpectedEx(tokOn);
ExceptionIdentifier;
Expected(tokDo);
Statement;
end;
procedure TmwSimplePasPar.ExceptionBlockElseBranch;
begin
case TokenID of
tokElse:
begin
NextToken;
StatementList;
end;
end;
end;
procedure TmwSimplePasPar.ExceptionIdentifier;
begin
Lexer.InitAhead;
case Lexer.AheadTokenID of
tokPoint:
begin
ExceptionClassTypeIdentifier;
end;
else
begin
ExceptionVariable;
case Lexer.TokenID of
tokColon:
begin
NextToken;
ExceptionClassTypeIdentifier;
end;
end;
end;
end;
end;
procedure TmwSimplePasPar.ExceptionClassTypeIdentifier;
begin
QualifiedIdentifier;
end;
procedure TmwSimplePasPar.ExceptionVariable;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.InlineStatement;
begin
Expected(tokInline);
Expected(tokRoundOpen);
Expected(tokIntegerConst);
while (TokenID = tokSlash) do
begin
NextToken;
Expected(tokIntegerConst);
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.InParameter;
begin
Expected(tokIn);
ParameterNameList;
case TokenID of
tokColon:
begin
NextToken;
NewFormalParameterType;
if TokenID = tokEqual then
begin
NextToken;
TypedConstant;
end;
end
end;
end;
procedure TmwSimplePasPar.AsmStatement;
begin
Lexer.AsmCode := True;
Expected(tokAsm);
{ should be replaced with a Assembler lexer }
while TokenID <> tokEnd do
case fLexer.TokenID of
tokBegin, tokCase, tokEnd, tokIf, tokFunction, tokProcedure, tokRepeat, tokwhile: break;
tokAddressOp:
begin
NextToken;
NextToken;
end;
tokDoubleAddressOp:
begin
NextToken;
NextToken;
end;
tokNull: //JThurman 10-26-2004. Need another way out of this.
begin
Expected(tokEnd);
Exit;
end;
else
NextToken;
end;
Lexer.AsmCode := False;
Expected(tokEnd);
end;
procedure TmwSimplePasPar.RaiseStatement;
begin
Expected(tokRaise);
case TokenID of
tokAddressOp, tokDoubleAddressOp, tokIdentifier, tokPointerSymbol, tokRoundOpen:
begin
Designator;
end;
end;
if ExID = tokAt then
begin
NextToken;
Expression;
end;
end;
procedure TmwSimplePasPar.TryStatement;
begin
Expected(tokTry);
StatementList;
case TokenID of
tokExcept:
begin
NextToken;
ExceptBlock;
if (TokenID = tokFinally) then
begin
NextToken;
StateMentList;
end;
Expected(tokEnd);
end;
tokFinally:
begin
NextToken;
StatementList;
if (TokenID = tokExcept) then
begin
NextToken;
StateMentList;
end;
Expected(tokEnd);
end;
else
begin
SynError(InvalidTryStatement);
end;
end;
end;
procedure TmwSimplePasPar.WithStatement;
begin
Expected(tokWith);
VariableList;
Expected(tokDo);
Statement;
end;
procedure TmwSimplePasPar.VariableList;
begin
VariableReference; (* acessing func.recordfield not allowed here;as well as UNITNAMEID *)
while fLexer.TokenID = tokComma do
begin
NextToken;
VariableReference;
end;
end;
procedure TmwSimplePasPar.StatementList;
begin {removed tokIntegerConst jdj-Put back in for labels}
while TokenID in [tokAddressOp, tokAsm, tokBegin, tokCase, tokDoubleAddressOp,
tokFor, tokGoTo, tokIdentifier, tokIf, tokInherited, tokInline, tokIntegerConst,
tokPointerSymbol, tokRaise, tokRoundOpen, tokRepeat, tokSemiColon, tokString,
tokTry, tokWhile, tokWith] do
begin
Statement;
SEMICOLON;
end;
end;
procedure TmwSimplePasPar.SimpleStatement;
begin
case TokenID of
tokAddressOp, tokDoubleAddressOp, tokIdentifier, tokPointerSymbol, tokRoundOpen:
begin
Designator;
if TokenID = tokAssign then
begin
NextToken;
if TokenID = tokInherited then
begin
NextToken;
end;
Expression;
end;
end;
tokGoTo:
begin
NextToken;
LabelId;
end;
end;
end;
procedure TmwSimplePasPar.Statement;
begin
case TokenID of
tokAsm:
begin
AsmStatement;
end;
tokBegin:
begin
CompoundStatement;
end;
tokCase:
begin
CaseStatement;
end;
tokFor:
begin
ForStatement;
end;
tokIf:
begin
IfStatement;
end;
tokIdentifier:
begin
fLexer.InitAhead;
case Lexer.AheadTokenID of
tokColon:
begin
LabeledStatement;
end;
else
begin
SimpleStatement;
end;
end;
end;
tokInherited:
begin
InheritedStatement;
end;
tokInLine:
begin
InlineStatement;
end;
tokIntegerConst:
begin
fLexer.InitAhead;
case Lexer.AheadTokenID of
tokColon:
begin
LabeledStatement;
end;
else
begin
SynError(InvalidLabeledStatement);
NextToken;
end;
end;
end;
tokRepeat:
begin
RepeatStatement;
end;
tokRaise:
begin
RaiseStatement;
end;
tokSemiColon:
begin
EmptyStatement;
end;
tokString:
begin
StringStatement;
end;
tokTry:
begin
TryStatement;
end;
tokWhile:
begin
WhileStatement;
end;
tokWith:
begin
WithStatement;
end;
else
begin
SimpleStatement;
end;
end;
end;
procedure TmwSimplePasPar.EmptyStatement;
begin
{ Nothing to do here.
The semicolon will be removed in StatementList }
end;
procedure TmwSimplePasPar.InheritedStatement;
begin
Expected(tokInherited);
case TokenID of
tokSemiColon: ;
else
begin
Statement;
end;
end;
end;
procedure TmwSimplePasPar.LabeledStatement;
begin
case TokenID of
tokIdentifier:
begin
NextToken;
Expected(tokColon);
Statement;
end;
tokIntegerConst:
begin
NextToken;
Expected(tokColon);
Statement;
end;
else
begin
SynError(InvalidLabeledStatement);
end;
end;
end;
procedure TmwSimplePasPar.StringStatement;
begin
Expected(tokString);
Statement;
end;
procedure TmwSimplePasPar.SetElement;
begin
Expression;
if TokenID = tokDotDot then
begin
NextToken;
Expression;
end;
end;
procedure TmwSimplePasPar.QualifiedIdentifier;
begin //mw 12/7/2000
Expected(tokIdentifier);
case TokenID of
tokPoint:
begin
while TokenID = tokPoint do
begin //jdj 1/7/2001
NextToken;
{$IFDEF D8_NEWER}
if TokenID in [tokAnd, tokArray, tokAs, tokASM, tokBegin, tokCase, tokClass,
tokConst, tokConstructor, tokDestructor, tokDispInterface, tokDiv, tokDo,
tokDOwnto, tokElse, tokEnd, tokExcept, tokExports, tokFile, tokFinal,
tokFinalization, tokFinally, tokFor, tokFunction, tokGoto, tokIf,
tokImplementation, tokIn, tokInherited, tokInitialization, tokInline,
tokInterface, tokIs, tokLabel, tokLibrary, tokMod, tokNil, tokNot, tokObject,
tokOf, tokOr, tokOut, tokPacked, tokProcedure, tokProgram, tokProperty,
tokRaise, tokRecord, tokRepeat, tokResourceString, tokSealed, tokSet,
tokShl, tokShr, tokStatic, tokString, tokThen, tokThreadVar, tokTo, tokTry,
tokType, tokUnit, tokUnsafe, tokUntil, tokUses, tokVar, tokWhile, tokWith,
tokXor] then
NextToken
else
{$ENDIF}
Expected(tokIdentifier);
if (TokenID = tokSquareOpen) then
begin
ConstantExpression;
end;
end;
end;
tokSquareOpen:
begin
ConstantExpression;
end;
end;
(* Expected(tokIdentifier); // old code for information removed in next versions
case TokenID of
tokPoint:
begin
NextToken;
Expected(tokIdentifier);
if (TokenID = tokSquareOpen) then
begin
ConstantExpression;
end;
end;
tokSquareOpen: {MW 20001207}
begin
ConstantExpression;
end;
end;*)
end;
procedure TmwSimplePasPar.SetConstructor;
begin
Expected(tokSquareOpen);
SetElement;
while TokenID = tokComma do
begin
NextToken;
SetElement;
end;
Expected(tokSquareClose);
end;
procedure TmwSimplePasPar.Number;
begin
case TokenID of
tokFloat:
begin
NextToken;
end;
tokIntegerConst:
begin
NextToken;
end;
tokIdentifier:
begin
NextToken;
end;
else
begin
SynError(InvalidNumber);
end;
end;
end;
procedure TmwSimplePasPar.ExpressionList;
begin
Expression;
if TokenID = tokAssign then //JT Nov 26, 2004 - supporting ole automation syntax
begin
Expected(tokAssign);
Expression;
end;
while TokenID = tokComma do
begin
NextToken;
Expression;
if TokenID = tokAssign then //JT Nov 26, 2004 - supporting ole automation syntax
begin
Expected(tokAssign);
Expression;
end;
end;
end;
procedure TmwSimplePasPar.Designator;
begin
VariableReference;
end;
procedure TmwSimplePasPar.MultiplicativeOperator;
begin
case TokenID of
tokAnd:
begin
NextToken;
end;
tokDiv:
begin
NextToken;
end;
tokMod:
begin
NextToken;
end;
tokShl:
begin
NextToken;
end;
tokShr:
begin
NextToken;
end;
tokSlash:
begin
NextToken;
end;
tokStar:
begin
NextToken;
end;
else
begin SynError(InvalidMultiplicativeOperator);
end;
end;
end;
procedure TmwSimplePasPar.Factor;
begin
case TokenID of
tokAsciiChar, tokStringConst:
begin
CharString;
end;
tokAddressOp, tokDoubleAddressOp, tokIdentifier, tokInherited, tokPointerSymbol,
tokRoundOpen:
begin
Designator;
end;
tokIntegerConst, tokFloat:
begin
Number;
end;
tokNil:
begin
NextToken;
end;
tokMinus:
begin
NextToken;
Factor;
end;
tokNot:
begin
NextToken;
Factor;
end;
tokPlus:
begin
NextToken;
Factor;
end;
tokSquareOpen:
begin
SetConstructor;
end;
tokString:
begin
NextToken;
Factor;
end;
tokFunction, tokProcedure:
AnonymousMethod;
end;
end;
procedure TmwSimplePasPar.AdditiveOperator;
begin
if TokenID in [tokMinus, tokOr, tokPlus, tokXor] then
begin
NextToken; // DR 2001-12-19
{
case TokenID of
tokMinus, tokPlus:
begin
while TokenID in [tokMinus, tokPlus] do
case TokenID of
tokMinus:
begin
NextToken;
end;
tokPlus:
begin
NextToken;
end;
end;
end;
tokOr:
begin
NextToken;
end;
tokXor:
begin
NextToken;
end;
end;}
end
else
begin
SynError(InvalidAdditiveOperator);
end;
end;
procedure TmwSimplePasPar.Term;
begin
Factor;
while TokenID in [tokAnd, tokDiv, tokMod, tokShl, tokShr, tokSlash, tokStar] do
begin
MultiplicativeOperator;
Factor;
end;
end;
procedure TmwSimplePasPar.RelativeOperator;
begin
case TokenID of
tokAs:
begin
NextToken;
end;
tokEqual:
begin
NextToken;
end;
tokGreater:
begin
NextToken;
end;
tokGreaterEqual:
begin
NextToken;
end;
tokIn:
begin
NextToken;
end;
tokIs:
begin
NextToken;
end;
tokLower:
begin
NextToken;
end;
tokLowerEqual:
begin
NextToken;
end;
tokNotEqual:
begin
NextToken;
end;
else
begin
SynError(InvalidRelativeOperator);
end;
end;
end;
procedure TmwSimplePasPar.SimpleExpression;
begin
(* while TokenID in [tokMinus, tokPlus] do
begin
NextToken; // DR 2001-12-19
end;
*)
Term;
while TokenID in [tokMinus, tokOr, tokPlus, tokXor] do
begin
AdditiveOperator;
Term;
end;
end;
procedure TmwSimplePasPar.Expression;
begin
SimpleExpression;
//JT 2006-07-17 The Delphi language guide has this as
//Expression -> SimpleExpression [RelOp SimpleExpression]...
//So this needs to be able to repeat itself.
case TokenID of
tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual, tokIn, tokIs,
tokNotEqual:
begin
while TokenID in [tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual,
tokIn, tokIs, tokNotEqual{, tokColon}] do
begin
RelativeOperator;
SimpleExpression;
end;
end;
tokColon:
begin
case fInRound of
False: ;
True:
while TokenID = tokColon do
begin
NextToken;
SimpleExpression;
end;
end;
end;
end;
end;
procedure TmwSimplePasPar.VarDeclaration;
begin
// !! Changed back to var name list from IdentifierList
VarNameList;
Expected(tokColon);
TypeKind;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
case GenID of
tokAbsolute:
begin
VarAbsolute;
end;
tokEqual:
begin
VarEqual;
end;
end;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.VarAbsolute;
begin
ExpectedEx(tokAbsolute);
ConstantValue;
end;
procedure TmwSimplePasPar.VarEqual;
begin
Expected(tokEqual);
ConstantValueTyped;
end;
procedure TmwSimplePasPar.VarNameList;
begin
VarName;
while TokenID = tokComma do
begin
NextToken;
VarName;
end;
end;
procedure TmwSimplePasPar.VarName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.DirectiveCalling;
begin
case ExID of
tokCdecl:
begin
NextToken;
end;
tokPascal:
begin
NextToken;
end;
tokRegister:
begin
NextToken;
end;
tokSafeCall:
begin
NextToken;
end;
tokStdCall:
begin
NextToken;
end;
else
begin
SynError(InvalidDirectiveCalling);
end;
end;
end;
procedure TmwSimplePasPar.RecordVariant;
begin
ConstantExpression;
while (TokenID = tokComma) do
begin
NextToken;
ConstantExpression;
end;
Expected(tokColon);
Expected(tokRoundOpen);
if TokenID <> tokRoundClose then
begin
FieldList;
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.VariantSection;
begin
Expected(tokCase);
TagField;
Expected(tokOf);
RecordVariant;
while TokenID = tokSemiColon do
begin
SEMICOLON;
case TokenID of //DR 2001-12-11
tokEnd, tokRoundClose: Break;
else
RecordVariant;
end;
end;
end;
procedure TmwSimplePasPar.TagField;
begin
TagFieldName;
case fLexer.TokenID of
tokColon:
begin
NextToken;
TagFieldTypeName;
end;
end;
end;
procedure TmwSimplePasPar.TagFieldName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.TagFieldTypeName;
begin
QualifiedIdentifier;
end;
procedure TmwSimplePasPar.FieldDeclaration;
begin
//IdentifierList;
FieldNameList;
Expected(tokColon);
TypeKind;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2002-01-09
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.FieldList;
begin
while TokenID = tokIdentifier do
begin
FieldDeclaration;
SEMICOLON;
end;
if TokenID = tokCase then
begin
VariantSection;
end;
end;
procedure TmwSimplePasPar.FieldName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.FieldNameList;
begin
FieldName;
while TokenID = tokComma do
begin
NextToken;
FieldName;
end;
end;
procedure TmwSimplePasPar.RecordType;
begin
Expected(tokRecord);
if TokenID = tokSemicolon then
Exit;
{$IFDEF D8_NEWER1}
if TokenID = tokRoundOpen then
begin
ClassHeritage;
if TokenID = tokSemicolon then
Exit;
end;
ClassMemberList;
{$ELSE}
FieldList;
{$ENDIF}
Expected(tokEnd);
end;
procedure TmwSimplePasPar.FileType;
begin
Expected(tokFile);
if TokenID = tokOf then
begin
NextToken;
TypeId;
end;
end;
procedure TmwSimplePasPar.SetType;
begin
Expected(tokSet);
Expected(tokOf);
OrdinalType;
end;
procedure TmwSimplePasPar.ArrayType;
begin
Expected(tokArray);
if TokenID = tokSquareOpen then
begin
NextToken;
OrdinalType;
while TokenID = tokComma do
begin
NextToken;
OrdinalType;
end;
Expected(tokSquareClose);
end;
Expected(tokOf);
TypeKind;
end;
procedure TmwSimplePasPar.EnumeratedType;
begin
Expected(tokRoundOpen);
EnumeratedTypeItem;
while TokenID = tokComma do
begin
NextToken;
EnumeratedTypeItem;
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.SubrangeType;
begin
ConstantExpression;
if TokenID = tokDotDot then
begin
NextToken;
ConstantExpression;
end;
end;
procedure TmwSimplePasPar.RealIdentifier;
begin
case ExID of
tokReal48:
begin
NextToken;
end;
tokReal:
begin
NextToken;
end;
tokSingle:
begin
NextToken;
end;
tokDouble:
begin
NextToken;
end;
tokExtended:
begin
NextToken;
end;
tokCurrency:
begin
NextToken;
end;
tokComp:
begin
NextToken;
end;
else
begin
SynError(InvalidRealIdentifier);
end;
end;
end;
procedure TmwSimplePasPar.RealType;
begin
case TokenID of
tokMinus:
begin
NextToken;
end;
tokPlus:
begin
NextToken;
end;
end;
case TokenId of
tokFloat:
begin
NextToken;
end;
else
begin
VariableReference;
end;
end;
end;
procedure TmwSimplePasPar.OrdinalIdentifier;
begin
case ExID of
tokBoolean:
begin
NextToken;
end;
tokByte:
begin
NextToken;
end;
tokBytebool:
begin
NextToken;
end;
tokCardinal:
begin
NextToken;
end;
tokChar:
begin
NextToken;
end;
tokDWord:
begin
NextToken;
end;
tokInt64:
begin
NextToken;
end;
tokInteger:
begin
NextToken;
end;
tokLongBool:
begin
NextToken;
end;
tokLongInt:
begin
NextToken;
end;
tokLongWord:
begin
NextToken;
end;
tokPChar:
begin
NextToken;
end;
tokShortInt:
begin
NextToken;
end;
tokSmallInt:
begin
NextToken;
end;
tokWideChar:
begin
NextToken;
end;
tokWord:
begin
NextToken;
end;
tokWordbool:
begin
NextToken;
end;
else
begin
SynError(InvalidOrdinalIdentifier);
end;
end;
end;
procedure TmwSimplePasPar.OrdinalType;
begin
case TokenID of
tokIdentifier:
begin
Lexer.InitAhead;
case Lexer.AheadTokenID of
tokPoint:
begin
Expression;
end;
tokRoundOpen:
begin //jdj
ConstantExpression;
end;
else
begin
TypeID;
end;
end;
end;
tokRoundOpen:
begin
EnumeratedType;
end;
tokSquareOpen:
begin
NextToken;
SubrangeType;
Expected(tokSquareClose);
end;
else
begin
Expression;
end;
end;
if TokenID = tokDotDot then
begin
NextToken;
ConstantExpression;
end;
end;
procedure TmwSimplePasPar.VariableReference;
begin
case TokenID of
tokAddressOp:
begin
NextToken;
variable;
end;
tokDoubleAddressOp:
begin
NextToken;
variable;
end;
tokPointerSymbol:
begin
NextToken;
case TokenID of
tokRoundClose, tokSquareClose: ;
else
begin
variable;
end;
end;
end;
else
variable;
end;
end;
procedure TmwSimplePasPar.Variable; (* Attention: could also came from proc_call ! ! *)
begin
case TokenID of
tokInherited:
begin
NextToken;
QualifiedIdentifier;
end;
tokPoint:
begin
VariableTwo;
end;
tokPointerSymbol:
begin
VariableTwo;
end;
tokRoundOpen:
begin
VariableTwo;
end;
tokSquareOpen:
begin
VariableTwo;
end;
//{$IFDEF D11_NEWER}
// tokLower:
// begin
// VariableTwo;
// end;
//{$ENDIF}
else
QualifiedIdentifier;
end;
VariableTwo;
case TokenID of
tokAs:
begin
NextToken;
QualifiedIdentifier;
end;
end;
end;
procedure TmwSimplePasPar.VariableTwo;
begin
case TokenID of
tokPoint:
begin
NextToken;
case TokenID of
tokAddressOp, tokDoubleAddressOp, tokIdentifier:
begin
VariableReference;
end;
tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
end;
tokPointerSymbol:
begin
NextToken;
case TokenID of
tokAddressOp, tokDoubleAddressOp, tokIdentifier:
begin
VariableReference;
end;
tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
end;
tokRoundOpen:
begin
NextToken;
fInRound := True;
case TokenID of
tokRoundClose:
begin
NextToken;
//Expected(tokRoundClose);
fInRound := False;
end;
else
begin
case TokenID of
tokAddressOp, tokDoubleAddressOp:
begin
VariableReference;
end;
tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
fInRound := True;
ExpressionList;
fInRound := True;
Expected(tokRoundClose);
fInRound := False;
end;
end;
case TokenID of
tokAddressOp, tokDoubleAddressOp:
begin
VariableReference;
end;
tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
end;
tokSquareOpen:
begin
Lexer.InitAhead;
while Lexer.AheadTokenID <> tokSemiColon do
begin
case Lexer.AheadTokenID of
tokBegin, tokClass, tokConst, tokEnd, tokDotDot, tokIn, tokNull, tokThreadVar, tokType,
tokVar: break;
else
Lexer.AheadNext;
end;
end;
case Lexer.AheadTokenID of
tokDotDot:
begin
SubrangeType;
end;
else
begin
NextToken;
case TokenID of
tokSquareClose:
begin
NextToken;
end;
else
begin
case TokenID of
tokAddressOp, tokDoubleAddressOp:
begin
VariableReference;
end;
tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
ExpressionList;
Expected(tokSquareClose);
end;
end;
case TokenID of
tokAddressOp, tokDoubleAddressOp:
begin
VariableReference;
end;
tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
end;
end;
end;
{$IFDEF D11_NEWER}
tokLower:
begin
InitAhead;
AheadParse.NextToken;
AheadParse.TypeKind;
if AheadParse.TokenId = tokGreater then
begin
NextToken;
TypeKind;
Expected(tokGreater);
case TokenID of
tokAddressOp, tokDoubleAddressOp, tokIdentifier:
begin
VariableReference;
end;
tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen:
begin
VariableTwo;
end;
end;
end;
end;
{$ENDIF}
end;
end;
procedure TmwSimplePasPar.InterfaceType;
begin
case TokenID of
tokInterface:
begin
NextToken;
end;
tokDispInterface:
begin
NextToken;
end
else
begin
SynError(InvalidInterfaceType);
end;
end;
case TokenID of
tokEnd:
begin
NextToken; { Direct descendant without new members }
end;
tokRoundOpen:
begin
InterfaceHeritage;
case TokenID of
tokEnd:
begin
NextToken; { No new members }
end;
tokSemiColon: ; { No new members }
else
begin
if TokenID = tokSquareOpen then
begin
InterfaceGUID;
end;
InterfaceMemberList;
Expected(tokEnd);
end;
end;
end;
else
begin
if TokenID = tokSquareOpen then
begin
InterfaceGUID;
end;
InterfaceMemberList; { Direct descendant }
Expected(tokEnd);
end;
end;
end;
procedure TmwSimplePasPar.InterfaceMemberList;
begin
while TokenID in [tokFunction, tokProcedure, tokProperty] do
begin
ClassMethodOrProperty;
end;
end;
procedure TmwSimplePasPar.ClassType;
begin
Expected(tokClass);
{$IFDEF D8_NEWER} //JThurman 2004-03-19
case TokenID of
tokIdentifier: //NASTY hack because Abstract is generally an ExID, except in this case when it should be a keyword.
case Lexer.ExID of
tokAbstract: ExpectedEx(tokAbstract);
tokHelper:
begin
ExpectedEx(tokHelper);
Expected(tokFor);
Expected(tokIdentifier);
end;
end;
tokSealed:
Expected(tokSealed);
end;
{$ENDIF}
case TokenID of
tokEnd:
begin
ClassTypeEnd; // DR 2001-07-31
NextToken; { Direct descendant of TObject without new members }
end;
tokRoundOpen:
begin
ClassHeritage;
case TokenID of
tokEnd:
begin
Expected(tokEnd); // DR 2001-07-31
ClassTypeEnd; // DR 2001-07-31
end;
tokSemiColon: ClassTypeEnd; // DR 2001-07-31
else
begin
ClassMemberList; { Direct descendant of TObject }
Expected(tokEnd); // DR 2001-07-31
ClassTypeEnd; // DR 2001-07-31
end;
end;
end;
else
begin
ClassMemberList; { Direct descendant of TObject }
Expected(tokEnd); // DR 2001-07-31
ClassTypeEnd; // DR 2001-07-31
end;
end;
end;
procedure TmwSimplePasPar.ClassHeritage;
begin
Expected(tokRoundOpen);
AncestorIdList;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.ClassVisibility;
begin
{$IFDEF D8_NEWER} //JThurman 2004-03-03
if TokenID = tokStrict then
Expected(tokStrict);
{$ENDIF}
while ExID in [tokAutomated, tokPrivate, tokProtected, tokPublic, tokPublished] do
begin
Lexer.InitAhead;
case Lexer.AheadExID of
tokColon, tokComma: ;
else
case ExID of
tokAutomated:
begin
VisibilityAutomated;
end;
tokPrivate:
begin
VisibilityPrivate;
end;
tokProtected:
begin
VisibilityProtected;
end;
tokPublic:
begin
VisibilityPublic;
end;
tokPublished:
begin
VisibilityPublished;
end;
end;
end;
end;
end;
procedure TmwSimplePasPar.VisibilityAutomated;
begin
ExpectedEx(tokAutomated);
end;
procedure TmwSimplePasPar.VisibilityPrivate;
begin
ExpectedEx(tokPrivate);
end;
procedure TmwSimplePasPar.VisibilityProtected;
begin
ExpectedEx(tokProtected);
end;
procedure TmwSimplePasPar.VisibilityPublic;
begin
ExpectedEx(tokPublic);
end;
procedure TmwSimplePasPar.VisibilityPublished;
begin
ExpectedEx(tokPublished);
end;
procedure TmwSimplePasPar.VisibilityUnknown;
begin
//
end;
procedure TmwSimplePasPar.ClassMemberList;
begin
ClassVisibility;
while TokenID in [tokClass, tokConstructor, tokDestructor, tokFunction,
tokIdentifier, tokProcedure, tokProperty
{$IFDEF D8_NEWER}, tokType, tokSquareOpen, tokVar, tokConst, tokStrict,
tokCase{$ENDIF}] do
begin
while (TokenID = tokIdentifier) and
not (ExID in [tokPrivate, tokProtected, tokPublished, tokPublic]) do
begin
ClassField;
SEMICOLON;
ClassVisibility;
end;
while TokenID in [tokClass, tokConstructor, tokDestructor, tokFunction,
tokProcedure, tokProperty{$IFDEF D8_NEWER}, tokSquareOpen, tokVar, tokConst{$ENDIF}] do
begin
ClassMethodOrProperty;
end;
{$IFDEF D8_NEWER}//JThurman 2004-03-22
{Nested types for D8}
while TokenID = tokType do
TypeSection;
while TokenID = tokCase do
begin
VariantSection;
end;
{$ENDIF}
ClassVisibility;
end;
end;
procedure TmwSimplePasPar.ClassMethodOrProperty;
begin
{$IFDEF D8_NEWER}
if TokenID = tokSquareOpen then
CustomAttribute;
{$ENDIF}
if TokenID = tokClass
then ClassClass; //DR 2001-07-16
case TokenID of
tokProperty:
begin
ClassProperty;
end;
{$IFDEF D8_NEWER}
tokVar:
begin
NextToken;
while (TokenID = tokIdentifier) and (ExID = tokUnknown) do
begin
ClassField;
SemiColon;
end;
end;
tokConst:
begin
NextToken;
while (TokenID = tokIdentifier) and (ExID = tokUnknown) do
begin
ConstantDeclaration;
SemiColon;
end;
end;
{$ENDIF}
else
begin
ClassMethodHeading;
end;
end;
end;
procedure TmwSimplePasPar.ClassProperty;
begin
// DR 2001-07-19 -> changed. for array-property override failure
Expected(tokProperty);
PropertyName;
case TokenID of
tokColon, tokSquareOpen:
begin
PropertyInterface;
end;
end;
PropertySpecifiers;
case ExID of
tokDefault:
begin
PropertyDefault; //DR 2001-07-16
SEMICOLON;
end;
end;
end;
procedure TmwSimplePasPar.PropertyName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ClassField;
begin
//IdentifierList;
FieldNameList;
Expected(tokColon);
TypeKind;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.ObjectType;
begin
Expected(tokObject);
case TokenID of
tokEnd:
begin
ObjectTypeEnd; // DR 2001-07-31
NextToken; { Direct descendant without new members }
end;
tokRoundOpen:
begin
ObjectHeritage;
case TokenID of
tokEnd:
begin
Expected(tokEnd); // DR 2001-07-31
ObjectTypeEnd; // DR 2001-07-31
end;
tokSemiColon: ObjectTypeEnd; // DR 2001-07-31
else
begin
ObjectMemberList; { Direct descendant }
Expected(tokEnd); // DR 2001-07-31
ObjectTypeEnd; // DR 2001-07-31
end;
end;
end;
else
begin
ObjectMemberList; { Direct descendant }
Expected(tokEnd); // DR 2001-07-31
ObjectTypeEnd; // DR 2001-07-31
end;
end;
end;
procedure TmwSimplePasPar.ObjectHeritage;
begin
Expected(tokRoundOpen);
AncestorIdList;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.ObjectMemberList;
begin {jdj added tokProperty-call to ObjectProperty 02/07/2001}
ObjectVisibility;
while TokenID in [tokConstructor, tokDestructor, tokFunction, tokIdentifier,
tokProcedure, tokProperty] do
begin
while TokenID = tokIdentifier do
begin
ObjectField;
SEMICOLON;
ObjectVisibility;
end;
while TokenID in [tokConstructor, tokDestructor, tokFunction, tokProcedure, tokProperty] do
begin
case TokenID of
tokConstructor, tokDestructor, tokFunction, tokProcedure:
ObjectMethodHeading;
tokProperty:
ObjectProperty;
end;
end;
ObjectVisibility;
end;
end;
procedure TmwSimplePasPar.ObjectVisibility;
begin
while ExID in [tokPrivate, tokProtected, tokPublic] do
begin
Lexer.InitAhead;
case Lexer.AheadExID of
tokColon, tokComma: ;
else
case ExID of
tokPrivate:
begin
VisibilityPrivate;
end;
tokProtected:
begin
VisibilityProtected;
end;
tokPublic:
begin
VisibilityPublic;
end;
end;
end;
end;
end;
procedure TmwSimplePasPar.ObjectField;
begin
IdentifierList;
Expected(tokColon);
TypeKind;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.ClassReferenceType;
begin
Expected(tokClass);
Expected(tokOf);
TypeId;
end;
procedure TmwSimplePasPar.VariantIdentifier;
begin
case ExID of
tokOleVariant:
begin
NextToken;
end;
tokVariant:
begin
NextToken;
end;
else
begin
SynError(InvalidVariantIdentifier);
end;
end;
end;
procedure TmwSimplePasPar.ProceduralType;
var
TheTokenID: TptTokenKind;
begin
case TokenID of
tokFunction:
begin
NextToken;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
Expected(tokColon);
ReturnType;
end;
tokProcedure:
begin
NextToken;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
end;
else
begin
SynError(InvalidProceduralType);
end;
end;
if TokenID = tokOf then
begin
NextToken;
Expected(tokObject);
end;
Lexer.InitAhead;
case TokenID of
tokSemiColon: TheTokenID := Lexer.AheadExID;
else
TheTokenID := ExID;
end;
while TheTokenID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar,
tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister,
tokReintroduce, tokSafeCall, tokStdCall, tokVirtual
{$IFDEF D8_NEWER}, tokStatic{$ENDIF}{$IFDEF D9_NEWER}, tokInline{$ENDIF}
] do
// DR 2001-11-14 no checking for deprecated etc. since it's captured by the typedecl
begin
if TokenID = tokSemiColon then SEMICOLON;
ProceduralDirective;
Lexer.InitAhead;
case TokenID of
tokSemiColon: TheTokenID := Lexer.AheadExID;
else
TheTokenID := ExID;
end;
end;
end;
procedure TmwSimplePasPar.StringIdentifier;
begin
case ExID of
tokAnsiString:
begin
NextToken;
end;
tokShortString:
begin
NextToken;
end;
tokWideString:
begin
NextToken;
end;
else
begin
SynError(InvalidStringIdentifier);
end;
end;
end;
procedure TmwSimplePasPar.StringType;
begin
case TokenID of
tokString:
begin
NextToken;
if TokenID = tokSquareOpen then
begin
NextToken;
ConstantExpression;
Expected(tokSquareClose);
end;
end;
else
begin
VariableReference;
end;
end;
end;
procedure TmwSimplePasPar.PointerType;
begin
Expected(tokPointerSymbol);
TypeId;
end;
procedure TmwSimplePasPar.StructuredType;
begin
if TokenID = tokPacked then
begin
NextToken;
end;
case TokenID of
tokArray:
begin
ArrayType;
end;
tokFile:
begin
FileType;
end;
tokRecord:
begin
RecordType;
end;
tokSet:
begin
SetType;
end;
else
begin
SynError(InvalidStructuredType);
end;
end;
end;
procedure TmwSimplePasPar.SimpleType;
begin
case TokenID of
tokMinus:
begin
NextToken;
end;
tokPlus:
begin
NextToken;
end;
end;
case fLexer.TokenID of
tokAsciiChar, tokIntegerConst:
begin
OrdinalType;
end;
tokFloat:
begin
RealType;
end;
tokIdentifier:
begin
fLexer.InitAhead;
case Lexer.AheadTokenID of
tokPoint, tokSemiColon:
begin
TypeID;
end;
else
begin
SimpleExpression;
if fLexer.TokenID = tokDotDot then
begin
NextToken;
SimpleExpression;
end;
end;
end;
end;
tokRoundOpen:
begin
EnumeratedType;
end;
tokSquareOpen:
begin
SubrangeType;
end;
else
begin
VariableReference;
end;
end;
end;
procedure TmwSimplePasPar.RecordFieldConstant;
begin
Expected(tokIdentifier);
Expected(tokColon);
TypedConstant;
end;
procedure TmwSimplePasPar.RecordConstant;
begin
Expected(tokRoundOpen);
RecordFieldConstant;
while (TokenID = tokSemiColon) do
begin
SEMICOLON;
if TokenId <> tokRoundClose then //jdj 2.23.2001
RecordFieldConstant;
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.ArrayConstant;
begin
Expected(tokRoundOpen);
TypedConstant;
while (TokenID = tokComma) do
begin
NextToken;
TypedConstant;
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.ClassForward;
begin
Expected(tokClass);
end;
procedure TmwSimplePasPar.DispInterfaceForward;
begin
Expected(tokDispInterface);
end;
procedure TmwSimplePasPar.InterfaceForward;
begin
Expected(tokInterface);
end;
procedure TmwSimplePasPar.ObjectForward;
begin
Expected(tokObject);
end;
procedure TmwSimplePasPar.TypeDeclaration;
begin
TypeName;
//For generics
// if TokenId = tokLower then
// TypeParams;
//end generics
Expected(tokEqual);
if TokenID = tokType then
begin
ExplicitType;
end;
Lexer.InitAhead;
case TokenID of
tokClass:
begin
case Lexer.AheadTokenID of
tokOf:
begin
ClassReferenceType;
end;
tokSemiColon:
begin
ClassForward;
end;
else
begin
ClassType;
end;
end;
end;
tokInterface:
begin
case Lexer.AheadTokenID of
tokSemiColon:
begin
InterfaceForward;
end;
else
begin
InterfaceType;
end;
end;
end;
tokDispInterface:
begin
case Lexer.AheadTokenID of
tokSemiColon:
begin
DispInterfaceForward;
end;
else
begin
InterfaceType;
end;
end;
end;
tokObject:
begin
case Lexer.AheadTokenID of
tokSemiColon:
begin
ObjectForward;
end;
else
begin
ObjectType;
end;
end;
end;
else
begin
{$IFDEF D12_NEWER}
if ExID = tokReference then
AnonymousMethodType
else
{$ENDIF}
TypeKind;
end;
end;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.TypeName;
begin
if (TokenID = tokString) then
NextToken
else
begin
Expected(tokIdentifier);
if TokenId = tokLower then
TypeParams;
end;
end;
procedure TmwSimplePasPar.ExplicitType;
begin
Expected(tokType);
end;
procedure TmwSimplePasPar.TypeKind;
begin
case TokenID of
tokAsciiChar, tokFloat, tokIntegerConst, tokMinus, tokNil, tokPlus, tokRoundOpen,
tokSquareOpen, tokStringConst:
begin
SimpleType;
end;
tokArray, tokFile, tokPacked, tokRecord, tokSet:
begin
StructuredType;
end;
tokFunction, tokProcedure:
begin
ProceduralType;
end;
tokIdentifier:
begin
Lexer.InitAhead;
case Lexer.AheadTokenID of
tokPoint, tokSemiColon, tokLower:
begin
TypeId;
end;
else
begin
SimpleExpression;
if Lexer.TokenID = tokDotDot then
begin
NextToken;
SimpleExpression;
end;
end;
end;
end;
tokPointerSymbol:
begin
PointerType;
end;
tokString:
begin
StringType;
end;
else
begin
SynError(InvalidTypeKind);
end;
end;
end;
procedure TmwSimplePasPar.TypeArgs;
begin
Expected(tokLower);
TypeId;
while TokenId = tokComma do
begin
NextToken;
TypeId;
end;
Expected(tokGreater);
end;
procedure TmwSimplePasPar.TypedConstant;
begin
case TokenID of
tokRoundOpen:
begin
Lexer.InitAhead;
while Lexer.AheadTokenID <> tokSemiColon do
case Lexer.AheadTokenID of
tokAnd, tokBegin, tokCase, tokColon, tokEnd, tokElse, tokIf, tokMinus, tokNull,
tokOr, tokPlus, tokShl, tokShr, tokSlash, tokStar, tokWhile, tokWith,
tokXor: break;
tokRoundOpen:
begin
repeat
case Lexer.AheadTokenID of
tokBegin, tokCase, tokEnd, tokElse, tokIf, tokNull, tokWhile, tokWith: break;
else
begin
case Lexer.AheadTokenID of
tokRoundClose:
begin
NextToken;
break;
end;
else
Lexer.AheadNext;
end;
end;
end;
until Lexer.AheadTokenID = tokRoundClose;
end;
else
Lexer.AheadNext;
end;
case Lexer.AheadTokenID of
tokColon:
begin
RecordConstant;
end;
tokNull: ;
tokAnd, tokMinus, tokOr, tokPlus, tokShl, tokShr, tokSlash, tokStar, tokXor:
begin
ConstantExpression;
end;
else
begin
ArrayConstant;
end;
end;
end;
tokSquareOpen:
ConstantExpression; // DR 2002-01-11
{ DR: fails with constructed set constants like
WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];
(*empty; there mustn't be all fields of a record mentioned*)
begin
NextToken;
if TokenID <> tokSquareClose then
begin
case TokenID of
tokDotDot:
begin
NextToken;
NextToken;
end;
else
NextToken;
case TokenID of
tokDotDot:
begin
NextToken;
NextToken;
end;
end;
end;
while TokenID = tokComma do
begin
NextToken;
NextToken;
case TokenID of
tokDotDot:
begin
NextToken;
NextToken;
end;
end;
end;
Expected(tokSquareClose);
end
else NextToken;
end;}
else
begin
ConstantExpression;
end;
end;
end;
procedure TmwSimplePasPar.TypeId;
begin
Lexer.InitAhead;
{$IFDEF D8_NEWER} //JThurman 2004-03-03
while Lexer.AheadTokenID = tokPoint do
begin
//UnitId;
NextToken;
Expected(tokPoint);
Lexer.InitAhead;
end;
{$ELSE}
if Lexer.AheadTokenID = tokPoint then
begin
UnitId;
Expected(tokPoint);
end;
{$ENDIF}
case GenID of
tokBoolean, tokByte, tokChar, tokDWord, tokInt64, tokInteger, tokLongInt,
tokLongWord, tokPChar, tokShortInt, tokSmallInt, tokWideChar, tokWord:
begin
OrdinalIdentifier;
end;
tokComp, tokCurrency, tokDouble, tokExtended, tokReal, tokReal48, tokSingle:
begin
RealIdentifier;
end;
tokAnsiString, tokShortString, tokWideString:
begin
StringIdentifier;
end;
tokOleVariant, tokVariant:
begin
VariantIdentifier;
end;
tokString:
begin
StringType;
end;
else
begin
//Problem: Delphi 8 allows things like 'Object' to be types
//when they are fully qualified (as System.Object, etc...), so
//tokIdentifier doesn't quite work right in this context
//TODO: Come up with a more elegant solution to the 'Object' dilemna
{$IFDEF D8_NEWER}//JThurman 2004-03-03
NextToken;
{$ELSE}
Expected(tokIdentifier);
{$ENDIF}
if TokenId = tokLower then
TypeArgs;
end;
end;
end;
procedure TmwSimplePasPar.ConstantExpression;
begin
Expression;
end;
procedure TmwSimplePasPar.ResourceDeclaration;
begin
Identifier;
Expected(tokEqual);
CharString;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2002-01-10
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.ConstantDeclaration;
begin
ConstantName;
case TokenID of
tokEqual:
begin
ConstantEqual;
end;
tokColon:
begin
ConstantColon;
end;
else
begin
SynError(InvalidConstantDeclaration);
end;
end;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
tokDeprecated: DirectiveDeprecated;
tokLibrary: DirectiveLibrary;
tokPlatform: DirectivePlatform;
end;
end;
procedure TmwSimplePasPar.ConstantColon;
begin
Expected(tokColon);
//JR changed to constant Type
ConstantType;
Expected(tokEqual);
ConstantValueTyped;
end;
procedure TmwSimplePasPar.ConstantEqual;
begin
Expected(tokEqual);
ConstantValue;
end;
procedure TmwSimplePasPar.ConstantValue;
begin
ConstantExpression;
end;
procedure TmwSimplePasPar.ConstantValueTyped;
begin
TypedConstant;
end;
procedure TmwSimplePasPar.ConstantName;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ConstantType;
begin
TypeKind;
end;
procedure TmwSimplePasPar.LabelId;
begin
case TokenID of
tokIntegerConst:
begin
NextToken;
end;
tokIdentifier:
begin
NextToken;
end;
else
begin
SynError(InvalidLabelId);
end;
end;
end;
procedure TmwSimplePasPar.ProcedureDeclarationSection;
begin
if TokenID = tokClass then
begin
NextToken;
end;
case TokenID of
tokConstructor:
begin
ProcedureMethodDeclaration;
end;
tokDestructor:
begin
ProcedureMethodDeclaration;
end;
tokProcedure:
begin
ProcedureMethodDeclaration;
end;
tokFunction:
begin
FunctionMethodDeclaration;
end;
{$IFDEF D8_NEWER} //JThurman 2004-03-2003
tokIdentifier:
begin
if Lexer.ExID = tokOperator then
begin
FunctionMethodDeclaration;
end
else
SynError(InvalidProcedureDeclarationSection);
end;
{$ENDIF}
else
begin
SynError(InvalidProcedureDeclarationSection);
end;
end;
end;
procedure TmwSimplePasPar.LabelDeclarationSection;
begin
Expected(tokLabel);
LabelId;
while (TokenID = tokComma) do
begin
NextToken;
LabelId;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.ProceduralDirective; //TODO: Add STATIC and FINAL
begin
case ExID of
tokAbstract:
begin
NextToken;
end;
tokCdecl, tokPascal, tokRegister, tokSafeCall, tokStdCall:
begin
DirectiveCalling;
end;
tokExport, tokFar, tokNear:
begin
Directive16Bit;
end;
tokExternal:
begin
ExternalDirective;
end;
tokDynamic, tokMessage, tokOverload, tokOverride, tokReintroduce, tokVirtual:
begin
DirectiveBinding;
end;
tokAssembler:
begin
NextToken;
end;
{$IFDEF D8_NEWER}
tokStatic:
begin
NextToken;
end;
{$ENDIF}
{$IFDEF D9_NEWER}
tokInline:
begin
NextToken;
end;
{$ENDIF}
tokDeprecated:
DirectiveDeprecated; // DR 2001-10-20
tokLibrary:
DirectiveLibrary; // DR 2001-10-20
tokPlatform:
DirectivePlatform; // DR 2001-10-20
tokLocal:
DirectiveLocal; // DR 2001-11-14
tokVarargs:
DirectiveVarargs; // DR 2001-11-14
else
begin
SynError(InvalidProceduralDirective);
end;
end;
end;
procedure TmwSimplePasPar.ExportedHeading;
begin
case TokenID of
tokFunction:
begin
FunctionHeading;
end;
tokProcedure:
begin
ProcedureHeading;
end;
else
begin
SynError(InvalidExportedHeading);
end;
end;
if TokenID = tokSemiColon then SEMICOLON;
case ExID of
tokForward:
begin
ForwardDeclaration; //jdj added 02/07/2001
// NextToken;
// SEMICOLON;
end;
tokAssembler:
begin
NextToken;
SEMICOLON;
if Exid = tokForward then
ForwardDeclaration; //jdj added 02/07/2001
end;
else //TODO: Add STATIC and FINAL
while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar,
tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister,
tokReintroduce, tokSafeCall, tokStdCall, tokVirtual,
tokDeprecated, tokLibrary, tokPlatform, // DR 2001-10-20
tokLocal, tokVarargs // DR 2001-11-14
{$IFDEF D8_NEWER}, tokStatic{$ENDIF}{$IFDEF D9_NEWER}, tokInline{$ENDIF}
] do
begin
ProceduralDirective;
if TokenID = tokSemiColon then SEMICOLON;
end;
if ExId = tokForward then
ForwardDeclaration; //jdj added 02/07/2001
end;
end;
procedure TmwSimplePasPar.FunctionHeading;
begin
Expected(tokFunction);
FunctionProcedureName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
Expected(tokColon);
ReturnType;
end;
procedure TmwSimplePasPar.ProcedureHeading;
begin
Expected(tokProcedure);
FunctionProcedureName;
if TokenID = tokRoundOpen then
begin
FormalParameterList;
end;
end;
procedure TmwSimplePasPar.VarSection;
begin
case TokenID of
tokThreadVar:
begin
NextToken;
end;
tokVar:
begin
NextToken;
end;
else
begin
SynError(InvalidVarSection);
end;
end;
{$IFDEF D8_NEWER}//JThurman 2004-03-22
while TokenID in [tokIdentifier, tokSquareOpen] do
begin
if TokenID = tokSquareOpen then
CustomAttribute
else
begin
VarDeclaration;
SEMICOLON;
end;
end;
{$ELSE}
while TokenID = tokIdentifier do
begin
VarDeclaration;
SEMICOLON;
end;
{$ENDIF}
end;
procedure TmwSimplePasPar.TypeSection;
begin
Expected(tokType);
{$IFDEF D8_NEWER}
while ((TokenID = tokIdentifier) and (Lexer.ExID in ExTypes)) or
(Lexer.TokenID = tokSquareOpen) or (Lexer.TokenID = tokString) do
begin
if TokenID = tokSquareOpen then
CustomAttribute
else
begin
TypeDeclaration;
if TokenID = tokEqual then
TypedConstant;
SEMICOLON;
end;
end;
{$ELSE}
while (TokenID = tokIdentifier) or (TokenID = tokString) do
begin
TypeDeclaration;
if TokenId = tokEqual then //jdj 8/2/00
TypedConstant;
SEMICOLON;
end;
{$ENDIF}
end;
procedure TmwSimplePasPar.TypeParamDecl;
begin
TypeParamList;
if TokenId = tokColon then
begin
NextToken;
ConstraintList;
end;
end;
procedure TmwSimplePasPar.TypeParamDeclList;
begin
TypeParamDecl;
while TokenId = tokSemicolon do
begin
NextToken;
TypeParamDecl;
end;
end;
procedure TmwSimplePasPar.TypeParamList;
begin
{$IFDEF D8_NEWER}
if TokenId = tokSquareOpen then
AttributeSection;
{$ENDIF}
Identifier;
while TokenId = tokComma do
begin
NextToken;
{$IFDEF D8_NEWER}
if TokenId = tokSquareOpen then
AttributeSection;
{$ENDIF}
Identifier;
end;
end;
procedure TmwSimplePasPar.TypeParams;
begin
Expected(tokLower);
TypeParamDeclList;
Expected(tokGreater);
end;
procedure TmwSimplePasPar.ConstSection;
begin
case TokenID of
tokConst:
begin
NextToken;
{$IFDEF D8_NEWER} //JThurman 2004-03-22
while TokenID in [tokIdentifier, tokSquareOpen] do
begin
if TokenID = tokSquareOpen then
CustomAttribute
else
begin
ConstantDeclaration;
SEMICOLON;
end;
end;
{$ELSE}
while (TokenID = tokIdentifier) do
begin
ConstantDeclaration;
SEMICOLON;
end;
{$ENDIF}
end;
tokResourceString:
begin
NextToken;
while (TokenID = tokIdentifier) do
begin
ResourceDeclaration;
SEMICOLON;
end;
end
else
begin
SynError(InvalidConstSection);
end;
end;
end;
procedure TmwSimplePasPar.InterfaceDeclaration;
begin
case TokenID of
tokConst:
begin
ConstSection;
end;
tokFunction:
begin
ExportedHeading;
end;
tokProcedure:
begin
ExportedHeading;
end;
tokResourceString:
begin
ConstSection;
end;
tokType:
begin
TypeSection;
end;
tokThreadVar:
begin
VarSection;
end;
tokVar:
begin
VarSection;
end;
tokExports:
begin
ExportsClause;
end;
{$IFDEF D8_NEWER} //JThurman 2004-03-03
tokSquareOpen:
begin
CustomAttribute;
end;
{$ENDIF}
else
begin
SynError(InvalidInterfaceDeclaration);
end;
end;
end;
procedure TmwSimplePasPar.ExportsElement;
begin
Expected(tokIdentifier);
// if TokenID = tokIndex then
if FLexer.ExID = tokIndex then //jdj 20001207
begin
NextToken;
Expected(tokIntegerConst);
end;
// if TokenID = tokName then
if FLexer.ExID = tokName then //jdj 20001207
begin
NextToken;
CharString;
end;
// if TokenID = tokResident then
if FLexer.ExID = tokResident then //jdj 20001207
begin
NextToken;
end;
end;
procedure TmwSimplePasPar.CompoundStatement;
begin
Expected(tokBegin);
StatementList;
Expected(tokEnd);
end;
procedure TmwSimplePasPar.ExportsClause;
begin
Expected(tokExports);
ExportsElement;
while TokenID = tokComma do
begin
NextToken;
ExportsElement;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.ContainsClause;
begin
ExpectedEx(tokContains);
ContainsStatement;
while TokenID = tokComma do
begin
NextToken;
ContainsStatement;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.ContainsStatement;
begin
ContainsIdentifier;
if fLexer.TokenID = tokIn then
begin
NextToken;
ContainsExpression;
end;
end;
procedure TmwSimplePasPar.ContainsIdentifier;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.ContainsExpression;
begin
ConstantExpression;
end;
procedure TmwSimplePasPar.RequiresClause;
begin
ExpectedEx(tokRequires);
RequiresIdentifier;
while TokenID = tokComma do
begin
NextToken;
RequiresIdentifier;
end;
SEMICOLON;
end;
procedure TmwSimplePasPar.RequiresIdentifier;
begin
Expected(tokIdentifier);
{$IFDEF D8_NEWER}
while Lexer.TokenID = tokPoint do
begin
NextToken;
Expected(tokIdentifier);
end;
{$ENDIF}
end;
procedure TmwSimplePasPar.InitializationSection;
begin
case TokenID of
tokInitialization:
begin
NextToken;
StatementList;
if TokenID = tokFinalization then
begin
NextToken;
StatementList;
end;
Expected(tokEnd);
end;
tokBegin:
begin
CompoundStatement;
end;
tokEnd:
begin
NextToken;
end;
else
begin
SynError(InvalidInitializationSection);
end;
end;
end;
procedure TmwSimplePasPar.ImplementationSection;
begin
Expected(tokImplementation);
if TokenID = tokUses then
begin
UsesClause;
end;
while TokenID in [tokClass, tokConst, tokConstructor, tokDestructor, tokFunction,
tokLabel, tokProcedure, tokResourceString, tokThreadVar, tokType, tokVar,
tokExports
{$IFDEF D8_NEWER}//JThurman 2004-03-22
, tokSquareOpen
{$ENDIF}
] do //tokResourceString added jdj
begin
DeclarationSection;
end;
end;
procedure TmwSimplePasPar.InterfaceSection;
begin
Expected(tokInterface);
if TokenID = tokUses then
begin
UsesClause;
end;
while TokenID in [tokConst, tokFunction, tokResourceString, tokProcedure,
tokThreadVar, tokType, tokVar, tokExports
{$IFDEF D8_NEWER} //JThurman 2004-03-03
, tokSquareOpen
{$ENDIF}
] do
begin
InterfaceDeclaration;
end;
end;
procedure TmwSimplePasPar.IdentifierList;
begin
Identifier; // DR 2001-10-20
while TokenID = tokComma do
begin
NextToken;
Identifier;
end;
end;
procedure TmwSimplePasPar.QualifiedIdentifierList;
begin
QualifiedIdentifier;
while (TokenID = tokComma) do
begin
NextToken;
QualifiedIdentifier;
end;
end;
procedure TmwSimplePasPar.CharString;
begin //updated mw 2/22/00, JThurman 6/24/2004
case TokenID of
tokAsciiChar, tokIdentifier, tokRoundOpen, tokStringConst:
while TokenID in
[tokAsciiChar, tokIdentifier, tokPlus, tokRoundOpen, tokStringConst,
tokString] do
begin
case TokenID of
tokIdentifier, tokRoundOpen:
begin
VariableReference;
end;
tokString: //JT
begin
StringStatement;
end;
else
NextToken;
end;
{$IFDEF D8_NEWER}
if Lexer.TokenID = tokPoint then
begin
NextToken;
VariableReference;
end;
{$ENDIF}
end;
else
begin
SynError(InvalidCharString);
end;
end;
end;
(*procedure TmwSimplePasPar.CharString;
begin //updated mw 2/22/00
case TokenID of
tokAsciiChar, tokIdentifier, tokRoundOpen, tokStringConst:
while TokenID in
[tokAsciiChar, tokIdentifier, tokPlus, tokRoundOpen, tokStringConst] do
begin
case TokenID of
tokIdentifier, tokRoundOpen:
begin
VariableReference;
end;
else
NextToken;
end;
end;
else
begin
SynError(InvalidCharString);
end;
end;
end;*)
(*procedure TmwSimplePasPar.CharString;
begin
case TokenID of
tokAsciiChar, tokStringConst:
while TokenID in [tokAsciiChar, tokPlus, tokStringConst] do
begin
case TokenID of
tokPlus:
begin
NextToken;
if TokenID = tokIdentifier then
begin
VariableReference;
end;
end;
else
begin
NextToken;
end;
end;
end;
tokIdentifier:
begin
VariableReference;
case TokenID of
tokPlus:
begin
NextToken;
while TokenID in [tokAsciiChar, tokPlus, tokStringConst] do
begin
case TokenID of
tokPlus:
begin
NextToken;
if TokenID = tokIdentifier then
begin
VariableReference;
end;
end;
else
begin
NextToken;
end;
end;
end;
end;
end;
end
else
begin
SynError(InvalidCharString);
end;
end;
end;*)
procedure TmwSimplePasPar.IncludeFile;
begin
while TokenID <> tokNull do
case TokenID of
tokClass:
begin
ProcedureDeclarationSection;
end;
tokConst:
begin
ConstSection;
end;
tokConstructor:
begin
ProcedureDeclarationSection;
end;
tokDestructor:
begin
ProcedureDeclarationSection;
end;
tokExports:
begin
ExportsClause;
end;
tokFunction:
begin
ProcedureDeclarationSection;
end;
tokIdentifier:
begin
Lexer.InitAhead;
if Lexer.AheadTokenID in [tokColon, tokEqual] then
begin
ConstantDeclaration;
if TokenID = tokSemiColon then SEMICOLON;
end
else
NextToken;
end;
tokLabel:
begin
LabelDeclarationSection;
end;
tokProcedure:
begin
ProcedureDeclarationSection;
end;
tokResourceString:
begin
ConstSection;
end;
tokType:
begin
TypeSection;
end;
tokThreadVar:
begin
VarSection;
end;
tokVar:
begin
VarSection;
end;
else
begin
NextToken;
end;
end;
end;
procedure TmwSimplePasPar.SkipSpace; //XM Jul-2000
begin
Expected(tokSpace);
while TokenID in [tokSpace] do
Lexer.Next;
end;
procedure TmwSimplePasPar.SkipCRLFco; //XM Jul-2000
begin
Expected(tokCRLFCo);
while TokenID in [tokCRLFCo] do
Lexer.Next;
end;
procedure TmwSimplePasPar.SkipCRLF; //XM Jul-2000
begin
Expected(tokCRLF);
while TokenID in [tokCRLF] do
Lexer.Next;
end;
procedure TmwSimplePasPar.ClassClass;
begin
Expected(tokClass);
end;
procedure TmwSimplePasPar.PropertyDefault;
begin
ExpectedEx(tokDefault);
end;
procedure TmwSimplePasPar.DispIDSpecifier; // DR 2001-07-26
begin
ExpectedEx(tokDispid);
ConstantExpression;
end;
procedure TmwSimplePasPar.IndexSpecifier;
begin
ExpectedEx(tokIndex);
ConstantExpression;
end;
procedure TmwSimplePasPar.ClassTypeEnd;
begin
end;
procedure TmwSimplePasPar.ObjectTypeEnd;
begin
end;
procedure TmwSimplePasPar.DirectiveDeprecated;
begin
ExpectedEx(tokDeprecated);
if TokenID = tokStringConst then
NextToken;
end;
procedure TmwSimplePasPar.DirectiveLibrary;
begin
ExpectedEx(tokLibrary);
end;
procedure TmwSimplePasPar.DirectivePlatform;
begin
ExpectedEx(tokPlatform);
end;
procedure TmwSimplePasPar.EnumeratedTypeItem;
begin
QualifiedIdentifier;
if TokenID = tokEqual then
begin
Expected(tokEqual);
ConstantExpression;
end;
end;
procedure TmwSimplePasPar.Identifier;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.DirectiveLocal;
begin
ExpectedEx(tokLocal);
end;
procedure TmwSimplePasPar.DirectiveVarargs;
begin
ExpectedEx(tokVarargs);
end;
procedure TmwSimplePasPar.AncestorId;
begin
// !! Although I re-added this function I modified it
// so that it now calls QualifiedIdentifier, per DR's change
QualifiedIdentifier;
end;
procedure TmwSimplePasPar.AncestorIdList;
begin
// !! Added this function back in
AncestorId;
while(TokenID = tokComma) do
begin
NextToken;
AncestorId;
end;
end;
procedure TmwSimplePasPar.AnonymousMethod;
begin
case TokenID of
tokFunction:
begin
NextToken;
if TokenID = tokRoundOpen then
FormalParameterList;
Expected(tokColon);
ReturnType;
end;
tokProcedure:
begin
NextToken;
if TokenId = tokRoundOpen then
FormalParameterList;
end;
end;
Block;
end;
procedure TmwSimplePasPar.AnonymousMethodType;
begin
{$IFDEF D11_NEWER}
ExpectedEx(tokReference); //ExID = tokReference
Expected(tokTo);
case TokenID of
tokProcedure:
begin
NextToken;
if TokenID = tokRoundOpen then
FormalParameterList;
end;
tokFunction:
begin
NextToken;
if TokenID = tokRoundOpen then
FormalParameterList;
Expected(tokColon);
ReturnType;
end;
end;
{$ENDIF}
end;
procedure TmwSimplePasPar.InitAhead;
begin
if AheadParse = nil then
AheadParse := TmwSimplePasPar.Create;
AheadParse.Lexer.InitFrom(Lexer);
end;
{$IFDEF D8_NEWER} //JThurman 2004-03-03
procedure TmwSimplePasPar.GlobalAttributes;
begin
GlobalAttributeSections;
end;
procedure TmwSimplePasPar.GlobalAttributeSections;
begin
while TokenID = tokSquareOpen do
GlobalAttributeSection;
end;
procedure TmwSimplePasPar.GlobalAttributeSection;
begin
Expected(tokSquareOpen);
GlobalAttributeTargetSpecifier;
AttributeList;
while TokenID = tokComma do
begin
Expected(tokComma);
GlobalAttributeTargetSpecifier;
AttributeList;
end;
Expected(tokSquareClose);
end;
procedure TmwSimplePasPar.GlobalAttributeTargetSpecifier;
begin
GlobalAttributeTarget;
Expected(tokColon);
end;
procedure TmwSimplePasPar.GlobalAttributeTarget;
begin
Expected(tokIdentifier);
end;
procedure TmwSimplePasPar.Attributes;
begin
AttributeSections;
end;
procedure TmwSimplePasPar.AttributeSections;
begin
while TokenID = tokSquareOpen do
AttributeSection;
end;
procedure TmwSimplePasPar.AttributeSection;
begin
Expected(tokSquareOpen);
Lexer.InitAhead;
if Lexer.AheadTokenID = tokColon then
AttributeTargetSpecifier;
AttributeList;
while TokenID = tokComma do
begin
Lexer.InitAhead;
if Lexer.AheadTokenID = tokColon then
AttributeTargetSpecifier;
AttributeList;
end;
Expected(tokSquareClose);
end;
procedure TmwSimplePasPar.AttributeTargetSpecifier;
begin
AttributeTarget;
Expected(tokColon);
end;
procedure TmwSimplePasPar.AttributeTarget;
begin
case TokenID of
tokProperty:
Expected(tokProperty);
tokType:
Expected(tokType);
else
Expected(tokIdentifier);
end;
end;
procedure TmwSimplePasPar.AttributeList;
begin
Attribute;
while TokenID = tokComma do
begin
Expected(tokComma);
AttributeList;
end;
end;
procedure TmwSimplePasPar.Attribute;
begin
AttributeName;
if TokenID = tokRoundOpen then
AttributeArguments;
end;
procedure TmwSimplePasPar.AttributeName;
begin
case TokenID of
tokIn, tokOut, tokConst, tokVar:
NextToken;
else
Expected(tokIdentifier);
end;
end;
procedure TmwSimplePasPar.AttributeArguments;
begin
Expected(tokRoundOpen);
if TokenID <> tokRoundClose then
begin
Lexer.InitAhead;
if Lexer.AheadTokenID = tokEqual then
NamedArgumentList
else
PositionalArgumentList;
if Lexer.TokenID = tokEqual then
NamedArgumentList;
end;
Expected(tokRoundClose);
end;
procedure TmwSimplePasPar.PositionalArgumentList;
begin
PositionalArgument;
while TokenID = tokComma do
begin
Expected(tokComma);
PositionalArgument;
end;
end;
procedure TmwSimplePasPar.PositionalArgument;
begin
AttributeArgumentExpression;
end;
procedure TmwSimplePasPar.NamedArgumentList;
begin
NamedArgument;
while TokenID = tokComma do
begin
Expected(tokComma);
NamedArgument;
end;
end;
procedure TmwSimplePasPar.NamedArgument;
begin
Expected(tokIdentifier);
Expected(tokEqual);
AttributeArgumentExpression;
end;
procedure TmwSimplePasPar.AttributeArgumentExpression;
begin
Expression;
end;
procedure TmwSimplePasPar.CustomAttribute;
begin
AttributeSection;//TODO: Global vs. Local attributes
{ Lexer.InitAhead;
if (Lexer.AheadToken = 'assembly') or (Lexer.AheadToken = 'module') then
GlobalAttributeSections
else}
AttributeSections;
end;
{$ENDIF}
end.