{--------------------------------------------------------------------------- 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.