12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291 |
- MODULE FoxParser; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler: Parser"; **)
- (* (c) fof ETH Zurich, 2009 *)
- IMPORT Basic := FoxBasic, Scanner := FoxScanner, D := Debugging, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Diagnostics;
- CONST
- Trace = FALSE;
- CascadedWithSupport = TRUE;
- (** the parser reflects the following EBNF:
- Module = ('module' | 'cellnet' [Flags]) Identifier ['in' Identifier]';'
- [ImportList] DeclarationSequence [Body]
- 'end' Identifier '.'.
-
- ImportList = 'import' Import { ',' Import } ';'.
- Import = Identifier [':=' Identifier] ['in' Identifier].
-
- DeclarationSequence = {
- 'const' [ConstDeclaration] {';' [ConstDeclaration]}
- |'type' [TypeDeclaration] {';' [TypeDeclaration]}
- |'var' [VariableDeclaration] {';' [VariableDeclaration]}
- | ProcedureDeclaration
- | OperatorDeclaration
- | ';'
- }
-
- Declaration = IdentifierDefinition '=' Expression.
- TypeDeclaration = IdentifierDefinition '=' Type.
- VariableDeclaration = VariableNameList ':' Type.
- VariableNameList = IdentifierDefinition [Flags] [':=' Expression | 'extern' String] {',' IdentifierDefinition [Flags] [':=' Expression | 'extern' String] }.
- OperatorDeclaration = 'operator' [Flags] ['-'] String ['*'|'-'] FormalParameters ';'
- DeclarationSequence [Body] 'end' String.
-
- ProcedureDeclaration = 'procedure' ['^'|'&'|'~'|'-'|Flags ['-']] IdentifierDefinition [FormalParameters]';'
- DeclarationSequence [Body] 'end' Identifier.
-
- Flags = '{' [Identifier ['(' Expression ')'|'=' Expression] {',' Identifier ['(' Expression ')' | '=' Expression ] } ] '}'.
- FormalParameters = '(' [ParameterDeclaration {';' ParameterDeclaration}] ')' [':' [Flags] Type].
- ParameterDeclaration = ['var'|'const'] Identifier [Flags] ['= Expression] {',' Identifier [Flags] ['= Expression]}':' Type.
-
- PortList = '(' [PortDeclaration {';' PortDeclaration}] ')'.
-
- PortDeclaration = Identifier [Flags] {',' Identifier [Flags]}':' Type.
-
- Type = ArrayType | RecordType | PointerType | ObjectType | CellType | CellnetType | PortType
- | ProcedureType | EnumerationType | QualifiedIdentifier.
-
- PortType = 'port' ('in'|'out') ['(' Expression ')']
-
- EnumerationType = 'enum' ['('QualifiedIdentifier')'] IdentifierDefinition ['=' Expression]
- {',' IdentifierDefinition ['=' Expression]} 'end'.
-
- ArrayType = 'array' 'of' Type | 'array' Expression {',' Expression} 'of' Type
- | 'array' '[' MathArraySize {',' MathArraySize} ']' ['of' Type].
-
- MathArraySize = Expression | '*' | '?'.
-
- RecordType = 'record' [Flags] ['(' QualifiedIdentifier ')'] [VariableDeclaration {';' VariableDeclaration}] 'end'.
-
- PointerType = 'pointer' [Flags] 'to' Type.
-
- CellType = 'cell' [Flags] [PortList] [';'] DeclarationSequence [Body] 'end' [Identifier].
-
- ObjectType = 'object' | 'object' [Flags] ['(' (QualifiedIdentifier | ArrayType) ')'] DeclarationSequence [Body] 'end' [Identifier] .
-
- ProcedureType = 'procedure' [Flags] [FormalParameters].
-
- Body = 'begin' [Flags] StatementSequence ['finally' StatementSequence]
- | 'code' Code.
-
- Code = { any \ 'end' \ 'with' } ['with' {('in'|'out') StatementSequence}] .
-
- StatementBlock = [Flags] StatementSequence.
-
- StatementSequence = Statement {';' Statement}.
-
- Statement =
- [
- Designator [':=' Expression |'!' Expression | '?' Expression | '<<' Expresssion | '>>' Expression]
- | 'if' Expression 'then' StatementSequence
- {'elsif' Expression 'then' StatementSequence}
- ['else' StatementSequence]
- 'end'
- | 'with' Identifier ':' QualifiedIdentifier 'do' StatementSequence
- {'|' Identifier ':' QualifiedIdentifier 'do' StatementSequence}
- [else StatementSequence]
- 'end'
- | 'case' Expression 'of' ['|'] Case {'|' Case} ['else' StatementSequence] 'end'
- | 'while' Expression 'do' StatementSequence 'end'
- | 'repeat' StatementSequence 'until' Expression
- | 'for' Identifier ':=' Expression 'to' Expression ['by' Expression] 'do'
- StatementSequence 'end'
- | 'loop' StatementSequence 'end'
- | 'exit'
- | 'return' [Expression]
- | 'await' Expression
- | 'begin' StatementBlock 'end'
- | 'code' {any} 'end'
- ].
-
- Case = RangeExpression {',' RangeExpression} ':' StatementSequence.
-
- Expression = RangeExpression [RelationOp RangeExpression].
-
- RelationOp = '=' | '.=' | '#' | '.#'
- | '<' | '.<' | '<=' | '.<=' | '>' | '.>' | '>=' | '.>='
- | '??' | '!!' | '<<?' | '>>?'
- | 'in' | 'is'
- SimpleExpression = ['+'|'-'] Term {AddOp Term}.
-
- AddOp = '+' | '-' | 'or'.
-
- Term = Factor {MulOp Factor}.
-
- MulOp = '*' | '**' | '.*' | '+*' | '/' | '\' | './' | 'div' | 'mod' | '&'.
- Factor = Number | Character | String | 'nil' | 'imag' | 'true' | 'false' | Set
- | '(' Expression ')' | '~' Factor | Factor '`' | Designator | MathArray.
- | 'SIZE' 'OF' Designator | 'ADDRESS' 'OF' Designator
- MathArray = '[' Expression {',' Expression} ']'.
-
- Set = '{' [ RangeExpression {',' RangeExpression} ] '}'.
-
- Designator = ('self' | 'result' | Identifier)
- {'.' Identifier | '[' IndexList ']' | '(' [ExpressionList] ')' | '^'} [Flags].
- RangeExpression = SimpleExpression | [SimpleExpression] '..' [SimpleExpression] ['by' SimpleExpression] | '*'.
- IndexList = '?' [',' ExpressionList ] | ExpressionList [',' '?'].
-
- ExpressionList = Expression { ',' Expression }.
-
- IdentifierDefinition = Identifier [ '*' | '-' ].
-
- QualifiedIdentifier = Identifier ['.' Identifier].
- Identifier = Letter {Letter | Digit | '_'}.
- Letter = 'A' | 'B' | .. | 'Z' | 'a' | 'b' | .. | 'z'.
- String = '"' {Character} '"' | "'" {Character} "'".
- Number = Integer | Real.
- Integer = Digit {Digit} | '0' 'x' {HexDigit} | Digit {HexDigit} 'H' .
- Real = Digit {Digit} '.' {Digit} [ScaleFactor].
- ScaleFactor = ('E' | 'D') ['+' | '-'] digit {digit}.
- HexDigit = Digit | 'A' | 'B' | 'C' | 'D' | 'E' | 'F'
- Digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' .
- **)
- TYPE
- Position*=Scanner.Position;
- Parser* = OBJECT
- VAR scanner-: Scanner.Scanner;
- symbol-: Scanner.Symbol;
- diagnostics: Diagnostics.Diagnostics;
- currentScope: SyntaxTree.Scope;
- recentCommentItem: ANY; recentLine: LONGINT;
- recentComment: SyntaxTree.Comment;
- moduleScope: SyntaxTree.ModuleScope;
- error-: BOOLEAN;
- Lax-: BOOLEAN;
- indent: LONGINT; (* for debugging purposes only *)
- hasSymbol: BOOLEAN;
- PROCEDURE S( CONST s: ARRAY OF CHAR ); (* for debugging purposes only *)
- VAR i: LONGINT;
- BEGIN
- D.Ln; INC( indent ); D.Int( indent,1 );
- FOR i := 1 TO indent DO D.Str( " " ); END;
- D.Str( "start: " ); D.Str( s ); D.Str( " at pos " ); D.Int( symbol.position.start,1 );
- END S;
- PROCEDURE E( CONST s: ARRAY OF CHAR ); (* for debugging purposes only *)
- VAR i: LONGINT;
- BEGIN
- D.Ln; D.Int( indent,1 );
- FOR i := 1 TO indent DO D.Str( " " ); END;
- D.Str( "end : " ); D.Str( s ); D.Str( " at pos " ); D.Int( symbol.position.start,1 );
- DEC(indent);
- END E;
- PROCEDURE EE( CONST s, t: ARRAY OF CHAR ); (* for debugging purposes only *)
- VAR i: LONGINT;
- BEGIN
- D.Ln; D.Int( indent,1 );
- FOR i := 1 TO indent DO D.Str( " " ); END;
- D.Str( "end : " ); D.Str( s ); D.Str( " (" ); D.Str( t ); D.Str( ") at pos " );
- DEC(indent);
- END EE;
- (** constructor, init parser with scanner providing input and with diagnostics for error output *)
- PROCEDURE & Init*( scanner: Scanner.Scanner; diagnostics: Diagnostics.Diagnostics );
- BEGIN
- SELF.scanner := scanner;
- SELF.diagnostics := diagnostics;
- error := ~scanner.GetNextSymbol(symbol);
- hasSymbol := TRUE;
- IF error THEN Basic.Error(diagnostics, scanner.source^, Basic.invalidPosition, "no input stream") END;
- recentCommentItem := NIL; recentComment := NIL;
- (* debugging *)
- indent := 0;
- Lax := FALSE;
- END Init;
-
- PROCEDURE Reset*;
- BEGIN
- error := FALSE;
- END Reset;
-
-
- PROCEDURE SetLax*;
- BEGIN
- Lax := TRUE;
- END SetLax;
-
- (** output error message and / or given code *)
- PROCEDURE Error(position: Position; code: LONGINT; CONST message: ARRAY OF CHAR);
- BEGIN
- Basic.ErrorC(diagnostics, scanner.source^, position, code, message);
- error := TRUE
- END Error;
- (** helper procedures interfacing to the scanner **)
- PROCEDURE SkipComments(b: BOOLEAN);
- VAR comment: SyntaxTree.Comment;
- BEGIN
- WHILE ~error & (b & (TokenB()= Scanner.Comment) OR ~b & (Token() = Scanner.Comment)) DO
- comment := SyntaxTree.NewComment(symbol.position, currentScope, symbol.string^,symbol.stringLength);
- IF moduleScope # NIL THEN
- moduleScope.AddComment(comment);
- END;
- IF recentComment = NIL THEN
- recentComment := comment;
- IF symbol.position.line = recentLine THEN
- IF recentCommentItem # NIL THEN
- IF (recentCommentItem IS SyntaxTree.Symbol) THEN
- IF recentCommentItem(SyntaxTree.Symbol).comment = NIL THEN
- recentCommentItem(SyntaxTree.Symbol).SetComment(comment)
- END;
- ELSIF (recentCommentItem IS SyntaxTree.Statement) THEN
- IF recentCommentItem(SyntaxTree.Statement).comment = NIL THEN
- recentCommentItem(SyntaxTree.Statement).SetComment(comment)
- END;
- ELSIF (recentCommentItem IS SyntaxTree.IfPart) THEN
- IF recentCommentItem(SyntaxTree.IfPart).comment = NIL THEN
- recentCommentItem(SyntaxTree.IfPart).SetComment(comment)
- END;
- ELSIF (recentCommentItem IS SyntaxTree.CasePart) THEN
- IF recentCommentItem(SyntaxTree.CasePart).comment = NIL THEN
- recentCommentItem(SyntaxTree.CasePart).SetComment(comment)
- END;
- ELSIF (recentCommentItem IS SyntaxTree.WithPart) THEN
- IF recentCommentItem(SyntaxTree.WithPart).comment = NIL THEN
- recentCommentItem(SyntaxTree.WithPart).SetComment(comment)
- END;
- END;
- comment.SetItem(recentCommentItem,TRUE);
- recentComment := NIL;
- recentCommentItem := NIL
- END;
- END;
- END;
- NextSymbol;
- (*error := ~scanner.GetNextSymbol(symbol);*)
- END;
- END SkipComments;
- (** Get next symbol from scanner and store it in object-local variable 'symbol' *)
- PROCEDURE NextSymbol*;
- VAR comment: SyntaxTree.Comment;
- BEGIN
- (*
- error := ~scanner.GetNextSymbol(symbol) OR error;
- hasSymbol := TRUE;
- SkipComments();
- *)
- hasSymbol := FALSE;
- END NextSymbol;
- PROCEDURE Token*(): LONGINT;
- BEGIN
- IF ~hasSymbol OR (symbol.token = Scanner.Escape) THEN
- error := ~scanner.GetNextSymbol(symbol) OR error;
- IF symbol.token = Scanner.Escape THEN
- error := ~scanner.GetNextSymbol(symbol) OR error;
- END;
- hasSymbol := TRUE;
- SkipComments(FALSE);
- END;
- RETURN symbol.token;
- END Token;
- (* stop on escape token *)
- PROCEDURE TokenB*(): LONGINT;
- BEGIN
- IF ~hasSymbol THEN
- error := ~scanner.GetNextSymbol(symbol) OR error;
- hasSymbol := TRUE;
- SkipComments(TRUE);
- END;
- RETURN symbol.token;
- END TokenB;
- (** Check if current symbol equals sym. If yes then return true, return false otherwise *)
- PROCEDURE PeekB*(token: Scanner.Token): BOOLEAN;
- VAR comment: SyntaxTree.Comment;
- BEGIN
- RETURN TokenB() = token
- END PeekB;
- (** Check if current symbol equals sym. If yes then return true, return false otherwise *)
- PROCEDURE Peek*(token: Scanner.Token): BOOLEAN;
- VAR comment: SyntaxTree.Comment;
- BEGIN
- SkipComments(FALSE);
- RETURN Token() = token
- END Peek;
- (** Check if the current symbol equals sym.If yes then read next symbol, report error otherwise. returns success value *)
- PROCEDURE Mandatory*( token: Scanner.Token): BOOLEAN;
- BEGIN
- ASSERT( token # Scanner.Identifier ); ASSERT( token # Scanner.String ); ASSERT( token # Scanner.Number ); (* because of NextSymbol ! *)
- IF ~Peek(token) THEN
- Error( symbol.position, token, "" );
- RETURN FALSE
- ELSE
- NextSymbol;
- RETURN TRUE
- END
- END Mandatory;
- (** Check if the current symbol equals sym. If yes then read next symbol, report error otherwise *)
- PROCEDURE Check( token: Scanner.Token );
- VAR b: BOOLEAN;
- BEGIN
- b := Mandatory( token );
- END Check;
- (** Check if current symbol is an identifier. If yes then copy identifier to name and get next symbol,
- report error otherwise and set name to empty name. returns success value *)
- PROCEDURE MandatoryIdentifier( VAR name: SyntaxTree.Identifier): BOOLEAN;
- BEGIN
- IF Peek(Scanner.Identifier) THEN
- name := symbol.identifier;
- NextSymbol;
- RETURN TRUE
- ELSE
- Error( symbol.position, Scanner.Identifier, "" );
- name := SyntaxTree.invalidIdentifier;
- RETURN FALSE
- END
- END MandatoryIdentifier;
- (** Expect an identifier (using MandatoryIdentifier) and return identifier object **)
- PROCEDURE Identifier(VAR position: Position): SyntaxTree.Identifier;
- VAR name: SyntaxTree.Identifier; identifier: SyntaxTree.Identifier;
- BEGIN
- position := symbol.position;
- IF MandatoryIdentifier(name) THEN
- identifier := name;
- ELSE
- identifier := SyntaxTree.invalidIdentifier;
- END;
- RETURN identifier
- END Identifier;
- (** Check if current symbol is a string (or string-like character). If yes then copy identifier to name and get next symbol,
- report error otherwise and set name to empty name. returns success value*)
- PROCEDURE MandatoryString*( VAR name: Scanner.StringType ): BOOLEAN;
- BEGIN
- IF Peek( Scanner.String) THEN
- name := symbol.string;
- NextSymbol;
- RETURN TRUE
- ELSIF Peek( Scanner.Character) THEN (* for compatibility with release: characters treated as strings *)
- name := symbol.string;
- NextSymbol;
- RETURN TRUE
- ELSE
- Error( symbol.position, Scanner.String, "" );
- NEW(name,1); name^ := "";
- RETURN FALSE
- END
- END MandatoryString;
- (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
- PROCEDURE ExpectThisIdentifier( name: SyntaxTree.Identifier ): BOOLEAN;
- VAR string: ARRAY 64 OF CHAR;
- BEGIN
- IF name = SyntaxTree.invalidIdentifier THEN (* nothing to be expected *)
- RETURN TRUE
- ELSIF (Token() # Scanner.Identifier) OR (symbol.identifier # name) THEN
- Basic.GetString(name,string);
- Error( symbol.position, Scanner.Identifier, string );
- RETURN FALSE
- ELSE
- NextSymbol;
- RETURN TRUE
- END
- END ExpectThisIdentifier;
- (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
- PROCEDURE ExpectThisString( CONST name: ARRAY OF CHAR ): BOOLEAN;
- BEGIN
- IF Peek(Scanner.String) & (symbol.string^ = name) THEN
- NextSymbol;
- RETURN TRUE
- ELSE
- Error( symbol.position, Scanner.String, name );
- RETURN FALSE
- END
- END ExpectThisString;
- (** Check if current symbol equals sym. If yes then get next symbol, return false otherwise *)
- PROCEDURE Optional*( token: Scanner.Token ): BOOLEAN;
- BEGIN
- (* do not use for Identifier, String or Number, if the result is needed ! *)
- IF Peek(token) THEN
- NextSymbol;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END
- END Optional;
- PROCEDURE OptionalB*( token: Scanner.Token ): BOOLEAN;
- BEGIN
- (* do not use for Identifier, String or Number, if the result is needed ! *)
- IF PeekB(token) THEN
- NextSymbol;
- RETURN TRUE
- ELSE
- RETURN FALSE
- END
- END OptionalB;
-
- (* ignore one ore more symbols of type token *)
- PROCEDURE Ignore(token: Scanner.Token);
- BEGIN WHILE Optional(token) DO END;
- END Ignore;
- (** Parsing according to the EBNF **)
- (** QualifiedIdentifier = Identifier ['.' Identifier]. **)
- PROCEDURE QualifiedIdentifier*( ): SyntaxTree.QualifiedIdentifier;
- VAR prefix,suffix: SyntaxTree.Identifier; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; position0,position1: Position;
- BEGIN
- IF Trace THEN S( "QualifiedIdentifier" ) END;
- prefix := Identifier(position0);
- IF prefix # SyntaxTree.invalidIdentifier THEN
- IF ~Optional( Scanner.Period )THEN
- suffix := prefix; prefix := SyntaxTree.invalidIdentifier; (* empty *)
- ELSE
- suffix := Identifier(position1);
- END;
- qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier( position0, prefix,suffix);
- ELSE
- qualifiedIdentifier := SyntaxTree.invalidQualifiedIdentifier;
- END;
- IF Trace THEN E( "QualifiedIdentifier" ) END;
- RETURN qualifiedIdentifier
- END QualifiedIdentifier;
- (** IdentifierDefinition = Identifier [ '*' | '-' ]. **)
- PROCEDURE IdentifierDefinition( VAR name: SyntaxTree.Identifier; VAR access: SET; allowedReadOnly: BOOLEAN);
- VAR position: Position;
- BEGIN
- IF Trace THEN S( "IdentifierDefinition" ) END;
- name := Identifier(position);
- IF Optional( Scanner.Times ) THEN
- access := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal;
- ELSIF Optional( Scanner.Minus ) THEN
- IF ~allowedReadOnly THEN
- Error( symbol.position, Diagnostics.Invalid, "may not be defined read-only" )
- ELSE
- access := SyntaxTree.ReadOnly + {SyntaxTree.InternalWrite};
- END;
- ELSE
- access := SyntaxTree.Internal;
- END;
- IF Trace THEN E( "IdentifierDefinition") END;
- END IdentifierDefinition;
- (** ExpressionList = Expression { ',' Expression }. **)
- PROCEDURE ExpressionList( expressionList: SyntaxTree.ExpressionList );
- VAR expression: SyntaxTree.Expression;
- BEGIN
- IF Trace THEN S( "ExpressionList" ) END;
- REPEAT
- expression := Expression();
- expressionList.AddExpression( expression )
- UNTIL ~Optional( Scanner.Comma );
- IF Trace THEN E( "ExpressionList" ) END;
- END ExpressionList;
- (** IndexList = '?' [',' ExpressionList ] | ExpressionList [',' '?']. **)
- PROCEDURE IndexList(expressionList: SyntaxTree.ExpressionList);
- VAR
- position: Position;
- done: BOOLEAN;
- BEGIN
- IF Trace THEN S( "IndexList" ) END;
- position := symbol.position;
- IF Optional(Scanner.Questionmark) THEN
- expressionList.AddExpression(SyntaxTree.NewTensorRangeExpression(position));
- IF Optional(Scanner.Comma) THEN
- ExpressionList(expressionList);
- END
- ELSE
- expressionList.AddExpression(Expression());
- done := FALSE;
- WHILE ~done DO
- IF Optional(Scanner.Comma) THEN
- IF Optional(Scanner.Questionmark) THEN
- expressionList.AddExpression(SyntaxTree.NewTensorRangeExpression(position));
- done := TRUE;
- ELSE
- expressionList.AddExpression(Expression())
- END
- ELSE
- done := TRUE
- END
- END
- END;
- IF Trace THEN E( "IndexList" ) END;
- END IndexList;
- (** RangeExpression = SimpleExpression | [SimpleExpression] '..' [SimpleExpression] ['by' SimpleExpression] | '*'.
- i.e., a RangeExpression can have one of the following forms:
- '*'
- '..' [delimiter]
- '..' 'by' SimpleExpression
- '..' SimpleExpression
- '..' SimpleExpression 'by' SimpleExpression
- SimpleExpression
- SimpleExpression '..' [delimiter]
- SimpleExpression '..' 'by' SimpleExpression
- SimpleExpression '..' SimpleExpression
- SimpleExpression '..' SimpleExpression 'by' SimpleExpression
- a RangeExpression is always delimited by any of the following tokens: ",", ";", ":", "]", ")", "}", "=", "#", "END".
- **)
- PROCEDURE RangeExpression(): SyntaxTree.Expression;
- VAR
- expression, first, last, step: SyntaxTree.Expression;
- position: Position;
- PROCEDURE HasDelimiter(): BOOLEAN;
- BEGIN RETURN
- Peek(Scanner.Comma) OR Peek(Scanner.Semicolon) OR Peek(Scanner.Colon) OR
- Peek(Scanner.RightBracket) OR Peek(Scanner.RightParenthesis) OR Peek(Scanner.RightBrace) OR
- Peek(Scanner.Equal) OR Peek(Scanner.Unequal) OR Peek(Scanner.End)
- END HasDelimiter;
- BEGIN
- IF Trace THEN S( "RangeExpression" ) END;
- position := symbol.position;
- IF Optional(Scanner.Times) THEN
- expression := SyntaxTree.NewRangeExpression(position, NIL, NIL, NIL)
- ELSIF Optional(Scanner.Upto) THEN
- (* is range expression *)
- first := NIL;
- IF HasDelimiter() THEN
- last := NIL;
- step := NIL
- ELSIF Optional(Scanner.By) THEN
- last := NIL;
- step := SimpleExpression()
- ELSE
- last := SimpleExpression();
- IF Optional(Scanner.By) THEN
- step := SimpleExpression()
- ELSE
- step := NIL
- END
- END;
- expression := SyntaxTree.NewRangeExpression(position, first, last, step)
- ELSE
- expression := SimpleExpression();
- IF OptionalB(Scanner.Upto) THEN
- (* is range expression *)
- first := expression;
- IF HasDelimiter() THEN
- last := NIL;
- step := NIL
- ELSIF Optional(Scanner.By) THEN
- last := NIL;
- step := SimpleExpression()
- ELSE
- last := SimpleExpression();
- IF Optional(Scanner.By) THEN
- step := SimpleExpression()
- ELSE
- step := NIL
- END
- END;
- expression := SyntaxTree.NewRangeExpression(position, first, last, step)
- END;
- END;
- IF Trace THEN E( "RangeExpression" ) END;
- RETURN expression
- END RangeExpression;
- (** Designator = ('self' | 'result' | Identifier)
- {'.' Identifier | '[' IndexList ']' | '(' [ExpressionList] ')' | '^'} [Flags].
- **)
- PROCEDURE Designator( ): SyntaxTree.Designator;
- VAR
- designator: SyntaxTree.Designator; expressionList: SyntaxTree.ExpressionList;
- identifier: SyntaxTree.Identifier; position: Position;
- qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
- qualifiedType : SyntaxTree.QualifiedType;
- BEGIN
- IF Trace THEN S( "Designator" ) END;
- position := symbol.position;
- IF Optional(Scanner.Self) THEN
- designator := SyntaxTree.NewSelfDesignator(position);
- ELSIF Optional(Scanner.Result) THEN
- designator := SyntaxTree.NewResultDesignator(position);
- ELSIF (Token() = Scanner.Address) OR (Token()=Scanner.Size) OR (Token() = Scanner.Alias) THEN
- identifier := symbol.identifier;
- designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
- NextSymbol;
- ELSIF (Token() = Scanner.New) THEN
- identifier := symbol.identifier;
- designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
- NextSymbol;
- IF Token() # Scanner.LeftParenthesis THEN (* NEW Type () *)
- qualifiedIdentifier := QualifiedIdentifier();
- qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, currentScope, qualifiedIdentifier);
- IF Mandatory( Scanner.LeftParenthesis ) THEN
- expressionList := SyntaxTree.NewExpressionList();
- IF ~Optional(Scanner.RightParenthesis) THEN
- ExpressionList( expressionList );
- Check( Scanner.RightParenthesis )
- END;
- END;
- designator := SyntaxTree.NewBuiltinCallDesignator(position,Global.New, NIL, expressionList);
- designator(SyntaxTree.BuiltinCallDesignator).SetReturnType(qualifiedType);
- (* special case: NEW Type() *)
- END;
- ELSE
- identifier := Identifier(position);
- designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
- END;
- LOOP
- position := symbol.position;
- IF OptionalB( Scanner.LeftParenthesis ) THEN
- expressionList := SyntaxTree.NewExpressionList();
- IF ~Optional( Scanner.RightParenthesis ) THEN
- ExpressionList( expressionList );
- Check( Scanner.RightParenthesis )
- END;
- designator := SyntaxTree.NewParameterDesignator( position,designator,expressionList);
- ELSIF OptionalB( Scanner.Period ) THEN
- IF ~Optional(Scanner.Identifier) THEN (* make sure symbol is read *) END;
- position := symbol.position;
- CASE symbol.identifierString[0] OF
- "a".."z", "A" .. "Z":
- (*IF Peek(Scanner.Size) (* special rule: support for SYSTEM.SIZE *) THEN*)
- identifier := symbol.identifier;
- NextSymbol;
- ELSE
- identifier := Identifier(position);
- END;
- designator := SyntaxTree.NewSelectorDesignator(position,designator,identifier);
- ELSIF OptionalB( Scanner.LeftBracket ) THEN
- expressionList := SyntaxTree.NewExpressionList();
- IndexList( expressionList );
- Check( Scanner.RightBracket );
- designator:= SyntaxTree.NewBracketDesignator( position,designator,expressionList );
- ELSIF OptionalB( Scanner.Arrow ) THEN
- designator:= SyntaxTree.NewArrowDesignator( position,designator );
- ELSE EXIT
- END;
- END;
- IF OptionalB(Scanner.LeftBrace) THEN
- designator.SetModifiers(Flags());
- END;
-
- (*IF OptionalB(Scanner.Escape) THEN END; (* skip breaking signal *)*)
- IF Trace THEN E( "Designator" ) END;
- RETURN designator
- END Designator;
- (** Set = '{' [ RangeExpression {',' RangeExpression} ] '}'. **)
- PROCEDURE Set( ): SyntaxTree.Expression;
- VAR
- set: SyntaxTree.Set;
- BEGIN
- IF Trace THEN S( "Set" ) END;
- set := SyntaxTree.NewSet(symbol.position);
- Check(Scanner.LeftBrace);
- IF ~Optional(Scanner.RightBrace) THEN
- REPEAT
- set.elements.AddExpression(RangeExpression())
- UNTIL ~Optional(Scanner.Comma);
- Check(Scanner.RightBrace);
- END;
- set.End(symbol.position.end);
- IF Trace THEN E( "Set" ) END;
- RETURN set
- END Set;
- (* MathArray = '[' Expression {',' Expression} ']'. *)
- PROCEDURE MathArray(): SyntaxTree.Expression;
- VAR array: SyntaxTree.MathArrayExpression; element: SyntaxTree.Expression;
- BEGIN
- array := SyntaxTree.NewMathArrayExpression(symbol.position);
- IF ~Optional(Scanner.RightBracket) THEN
- REPEAT
- element := Expression();
- array.elements.AddExpression(element);
- UNTIL ~Optional(Scanner.Comma);
- Check(Scanner.RightBracket);
- END;
- RETURN array
- END MathArray;
- (** Factor = Number | Character | String | 'nil' | 'imag' | 'true' | 'false' | Set
- | '(' Expression ')' | '~' Factor | Factor '`' | Designator | MathArray.
- | 'SIZE' 'OF' Designator | 'ADDRESS' 'OF' Designator
- **)
- PROCEDURE Factor( ): SyntaxTree.Expression;
- VAR factor: SyntaxTree.Expression; position: Position; operator: LONGINT;
- BEGIN
- IF Trace THEN S( "Factor" ) END;
- position := symbol.position;
- CASE Token() OF
- | Scanner.Number:
- IF (symbol.numberType = Scanner.Integer) THEN
- factor := SyntaxTree.NewIntegerValue( position, symbol.integer);
- ELSIF (symbol.numberType = Scanner.Hugeint) THEN
- factor := SyntaxTree.NewIntegerValue(position, symbol.hugeint);
- ELSIF (symbol.numberType = Scanner.Real) OR (symbol.numberType = Scanner.Longreal) THEN
- factor := SyntaxTree.NewRealValue( position, symbol.real);
- factor(SyntaxTree.RealValue).SetSubtype(symbol.numberType);
- ELSE HALT( 100 )
- END;
- NextSymbol;
- | Scanner.Character:
- factor := SyntaxTree.NewCharacterValue(position,symbol.character);
- NextSymbol;
- | Scanner.String:
- factor := SyntaxTree.NewStringValue( position, symbol.string );
- NextSymbol;
- WHILE (Token() = Scanner.String) OR (Token() = Scanner.Character) DO
- IF Token() = Scanner.Character THEN
- factor(SyntaxTree.StringValue).AppendChar(symbol.character);
- ELSE
- factor(SyntaxTree.StringValue).Append(symbol.string);
- END;
- factor.End(symbol.position.end);
- NextSymbol;
- END;
- | Scanner.Nil:
- factor := SyntaxTree.NewNilValue( position );
- NextSymbol;
- | Scanner.Imag:
- factor := SyntaxTree.NewComplexValue(position, 0, 1);
- factor(SyntaxTree.ComplexValue).SetSubtype(Scanner.Real);
- NextSymbol;
- | Scanner.True:
- factor := SyntaxTree.NewBooleanValue( position, TRUE );
- NextSymbol;
- | Scanner.False:
- factor := SyntaxTree.NewBooleanValue( position, FALSE );
- NextSymbol;
- | Scanner.LeftBrace:
- factor := Set();
- | Scanner.LeftParenthesis:
- NextSymbol;
- factor := Expression();
- Check( Scanner.RightParenthesis );
- factor.End( symbol.position.end );
- | Scanner.Not:
- NextSymbol;
- factor := Factor();
- factor := SyntaxTree.NewUnaryExpression( position, factor, Scanner.Not );
- factor.End( symbol.position.end );
- | Scanner.Address, Scanner.Size, Scanner.Alias:
- operator := Token();
- factor := Designator();
- IF Optional(Scanner.Of) THEN
- factor := Designator();
- factor := SyntaxTree.NewUnaryExpression( position, factor, operator );
- END;
- factor.End (symbol.position.end)
- | Scanner.Self, Scanner.Result, Scanner.Identifier, Scanner.New:
- factor := Designator();
- factor.End( symbol.position.end );
- | Scanner.LeftBracket:
- NextSymbol;
- factor := MathArray();
- factor.End(symbol.position.end);
- ELSE
- Error( position, Basic.ValueStartIncorrectSymbol, "" );
- NextSymbol; factor := SyntaxTree.invalidExpression;
- END;
- (* suffix *)
- IF OptionalB(Scanner.Transpose) THEN
- IF (factor IS SyntaxTree.UnaryExpression) & (factor(SyntaxTree.UnaryExpression).operator = Scanner.Transpose) THEN
- (* transpose operator has higher precedence than not, reevaluate expression: *)
- factor := factor(SyntaxTree.UnaryExpression).left;
- factor := SyntaxTree.NewUnaryExpression(position,factor,Scanner.Transpose);
- factor := SyntaxTree.NewUnaryExpression(position,factor,Scanner.Not);
- ELSE
- factor := SyntaxTree.NewUnaryExpression(position,factor,Scanner.Transpose);
- END;
- END;
- IF Trace THEN E( "Factor" ) END;
- RETURN factor
- END Factor;
- (** Term = Factor {MulOp Factor}.
- MulOp = '*' | '**' | '.*' | '+*' | '/' | '\' | './' | 'div' | 'mod' | '&'.
- **)
- PROCEDURE Term( ): SyntaxTree.Expression;
- VAR term, factor: SyntaxTree.Expression; operator: LONGINT; position: Position;
- BEGIN
- IF Trace THEN S( "Term" ) END;
- position := symbol.position;
- term := Factor();
- WHILE (TokenB() >= Scanner.Times) & (TokenB() <= Scanner.And) DO
- operator := Token();
- NextSymbol;
- factor := Factor();
- term := SyntaxTree.NewBinaryExpression( position, term, factor, operator );
- END;
- term.End( symbol.position.end );
- IF Trace THEN E( "Term" ) END;
- RETURN term
- END Term;
- (** SimpleExpression = ['+'|'-'] Term {AddOp Term}.
- AddOp = '+' | '-' | 'or'.
- **)
- PROCEDURE SimpleExpression( ): SyntaxTree.Expression;
- VAR operator: LONGINT; term, expression: SyntaxTree.Expression; position: Position;
- BEGIN
- IF Trace THEN S( "SimpleExpression" ) END;
- position := symbol.position;
- IF Peek(Scanner.Plus) OR Peek(Scanner.Minus) THEN (* sign should be part of the factor *)
- operator := Token();
- NextSymbol;
- term := Term();
- expression := SyntaxTree.NewUnaryExpression( position, term, operator );
- ELSE expression := Term();
- END;
- WHILE (TokenB() >= Scanner.Or) & (TokenB() <= Scanner.Minus) DO
- operator := Token();
- NextSymbol;
- term := Term();
- expression := SyntaxTree.NewBinaryExpression( position, expression, term, operator );
- END;
- IF Trace THEN E( "SimpleExpression" ) END;
- RETURN expression
- END SimpleExpression;
- (**
- Expression = RangeExpression [RelationOp RangeExpression].
- RelationOp = '=' | '.=' | '#' | '.#'
- | '<' | '.<' | '<=' | '.<=' | '>' | '.>' | '>=' | '.>='
- | '??' | '!!' | '<<?' | '>>?'
- | 'in' | 'is'
- **)
- PROCEDURE Expression*( ): SyntaxTree.Expression;
- VAR expression, rightExpression: SyntaxTree.Expression; operator: LONGINT; position: Position;
- BEGIN
- IF Trace THEN S( "Expression" ) END;
- position := symbol.position;
- expression := RangeExpression();
- IF (TokenB() >= Scanner.Equal) & (TokenB() <= Scanner.Is) THEN
- operator := Token();
- NextSymbol;
- rightExpression := RangeExpression();
- expression := SyntaxTree.NewBinaryExpression(position, expression, rightExpression, operator );
- END;
- (*IF OptionalB(Scanner.Escape) THEN END; (* skip breaking escape *)*)
- IF Trace THEN E( "Expression" ) END;
- RETURN expression
- END Expression;
- (** Case = RangeExpression {',' RangeExpression} ':' StatementSequence. **)
- PROCEDURE Case( caseStatement: SyntaxTree.CaseStatement );
- VAR
- casePart: SyntaxTree.CasePart;
- statements: SyntaxTree.StatementSequence;
- element: SyntaxTree.Expression;
- BEGIN
- IF Trace THEN S( "Case" ) END;
- casePart := SyntaxTree.NewCasePart();
- CommentCasePart(casePart);
- REPEAT
- element := RangeExpression();
- casePart.elements.AddExpression( element );
- UNTIL ~Optional( Scanner.Comma );
- Check( Scanner.Colon );
- statements := StatementSequence(caseStatement);
- casePart.SetStatements( statements );
- caseStatement.AddCasePart( casePart );
- IF Trace THEN E( "Case" ) END;
- END Case;
- (** Statement =
- [
- Designator [':=' Expression |'!' Expression | '?' Expression | '<<' Expresssion | '>>' Expression]
- | 'if' Expression 'then' StatementSequence
- {'elsif' Expression 'then' StatementSequence}
- ['else' StatementSequence]
- 'end'
- | 'with' Identifier ':' QualifiedIdentifier 'do' StatementSequence
- {'|' Identifier ':' QualifiedIdentifier 'do' StatementSequence}
- [else StatementSequence]
- 'end'
- | 'case' Expression 'of' ['|'] Case {'|' Case} ['else' StatementSequence] 'end'
- | 'while' Expression 'do' StatementSequence 'end'
- | 'repeat' StatementSequence 'until' Expression
- | 'for' Identifier ':=' Expression 'to' Expression ['by' Expression] 'do'
- StatementSequence 'end'
- | 'loop' StatementSequence 'end'
- | 'exit'
- | 'return' [Expression]
- | 'await' Expression
- | 'begin' StatementBlock 'end'
- | 'code' {any} 'end'
- ].
- **)
- PROCEDURE Statement*( statements: SyntaxTree.StatementSequence; outer: SyntaxTree.Statement): BOOLEAN;
- VAR qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; expression: SyntaxTree.Expression; designator: SyntaxTree.Designator; statement: SyntaxTree.Statement;
- ifStatement: SyntaxTree.IfStatement; elsifPart: SyntaxTree.IfPart; statementSequence: SyntaxTree.StatementSequence; withStatement: SyntaxTree.WithStatement;
- withPart: SyntaxTree.WithPart; caller: SyntaxTree.ProcedureCallStatement;
- caseStatement: SyntaxTree.CaseStatement; whileStatement: SyntaxTree.WhileStatement; repeatStatement: SyntaxTree.RepeatStatement; forStatement: SyntaxTree.ForStatement;
- identifier: SyntaxTree.Identifier; loopStatement: SyntaxTree.LoopStatement; returnStatement: SyntaxTree.ReturnStatement; awaitStatement: SyntaxTree.AwaitStatement;
- qualifiedType: SyntaxTree.QualifiedType; code : SyntaxTree.Code; position: Position; result: BOOLEAN;
- commToken: Scanner.Token;
- BEGIN
- IF Trace THEN S( "Statement" ) END;
- CASE Token() OF
- | Scanner.Identifier, Scanner.Self, Scanner.Result, Scanner.New:
- designator := Designator();
- position := symbol.position;
- IF OptionalB( Scanner.Becomes ) THEN
- expression := Expression();
- statement := SyntaxTree.NewAssignment( position, designator, expression,outer );
- CommentStatement(statement);
- ELSIF PeekB(Scanner.ExclamationMark) OR PeekB(Scanner.Questionmark) OR PeekB(Scanner.LessLess) OR PeekB(Scanner.GreaterGreater) THEN
- commToken := Token();
- NextSymbol;
- expression := Expression();
- statement := SyntaxTree.NewCommunicationStatement(position, commToken, designator, expression, outer);
- CommentStatement(statement);
- ELSE
- caller := SyntaxTree.NewProcedureCallStatement(designator.position, designator,outer);
- statement := caller;
- CommentStatement(statement);
- END;
- statements.AddStatement( statement );
- (*IF OptionalB(Scanner.Escape) THEN END;*)
- result := TRUE
- | Scanner.If:
- NextSymbol;
- ifStatement := SyntaxTree.NewIfStatement( symbol.position ,outer);
- CommentStatement(ifStatement);
- expression := Expression();
- ifStatement.ifPart.SetCondition( expression );
- Check( Scanner.Then );
- statementSequence := StatementSequence(ifStatement);
- ifStatement.ifPart.SetStatements( statementSequence );
- WHILE Optional( Scanner.Elsif ) DO
- elsifPart := SyntaxTree.NewIfPart();
- CommentIfPart(elsifPart);
- ifStatement.AddElsifPart( elsifPart);
- expression := Expression();
- elsifPart.SetCondition( expression );
- Check( Scanner.Then );
- statementSequence := StatementSequence(ifStatement);
- elsifPart.SetStatements( statementSequence );
- END;
- IF Optional( Scanner.Else ) THEN
- statementSequence := StatementSequence(ifStatement);
- ifStatement.SetElsePart( statementSequence );
- END;
- Check( Scanner.End ); statements.AddStatement( ifStatement );
- result := TRUE
- | Scanner.With:
- withStatement := SyntaxTree.NewWithStatement( symbol.position ,outer);
- CommentStatement(withStatement);
- NextSymbol;
- REPEAT
- identifier := Identifier(position);
- IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
- Error(position,Diagnostics.Invalid,"forbidden qualified identifier in with statement");
- END;
- withPart := SyntaxTree.NewWithPart();
- CommentWithPart(withPart);
- withStatement.AddWithPart(withPart);
- designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
- withPart.SetVariable( designator );
- Check( Scanner.Colon );
- qualifiedIdentifier := QualifiedIdentifier();
- qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, currentScope, qualifiedIdentifier);
- withPart.SetType(qualifiedType);
- Check( Scanner.Do );
- statementSequence := StatementSequence(withStatement);
- withPart.SetStatements( statementSequence );
- UNTIL ~Optional(Scanner.Bar) OR ~CascadedWithSupport;
- IF CascadedWithSupport & Optional(Scanner.Else) THEN
- statementSequence := StatementSequence(withStatement);
- withStatement.SetElsePart(statementSequence);
- END;
- Check( Scanner.End );
- statements.AddStatement( withStatement );
- result := TRUE
- | Scanner.Case:
- caseStatement := SyntaxTree.NewCaseStatement( symbol.position,outer );
- CommentStatement(caseStatement);
- NextSymbol;
- expression := Expression();
- Check( Scanner.Of );
- caseStatement.SetVariable( expression );
- IF Optional(Scanner.Bar) THEN END;
- REPEAT
- Case(caseStatement)
- UNTIL ~Optional(Scanner.Bar);
- IF Optional( Scanner.Else ) THEN
- statementSequence := StatementSequence(caseStatement);
- caseStatement.SetElsePart( statementSequence );
- END;
- Check( Scanner.End );
- statements.AddStatement( caseStatement );
- result := TRUE
- | Scanner.While:
- NextSymbol;
- whileStatement := SyntaxTree.NewWhileStatement( symbol.position, outer );
- CommentStatement(whileStatement);
- expression := Expression();
- Check( Scanner.Do );
- whileStatement.SetCondition( expression );
- statementSequence := StatementSequence(whileStatement);
- whileStatement.SetStatements( statementSequence );
- Check( Scanner.End );
- statements.AddStatement( whileStatement );
- result := TRUE
- | Scanner.Repeat:
- NextSymbol;
- repeatStatement := SyntaxTree.NewRepeatStatement( symbol.position, outer );
- CommentStatement(repeatStatement);
- statementSequence := StatementSequence(repeatStatement);
- repeatStatement.SetStatements( statementSequence );
- Check( Scanner.Until );
- expression := Expression();
- repeatStatement.SetCondition( expression );
- statements.AddStatement( repeatStatement );
- result := TRUE
- | Scanner.For:
- NextSymbol;
- forStatement := SyntaxTree.NewForStatement( symbol.position, outer);
- CommentStatement(forStatement);
- identifier := Identifier(position);
- IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
- Error(position,Diagnostics.Invalid,"forbidden non-local counter variable");
- END;
- designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
- forStatement.SetVariable( designator );
- Check( Scanner.Becomes );
- expression := Expression();
- forStatement.SetFrom( expression );
- Check( Scanner.To );
- expression := Expression();
- forStatement.SetTo( expression );
- IF Optional( Scanner.By ) THEN
- expression := Expression();
- forStatement.SetBy( expression );
- END;
- Check( Scanner.Do );
- statementSequence := StatementSequence(forStatement);
- forStatement.SetStatements( statementSequence );
- Check( Scanner.End );
- statements.AddStatement( forStatement );
- result := TRUE
- | Scanner.Loop:
- NextSymbol;
- loopStatement := SyntaxTree.NewLoopStatement( symbol.position ,outer);
- CommentStatement(loopStatement);
- statementSequence := StatementSequence(loopStatement);
- loopStatement.SetStatements( statementSequence );
- Check( Scanner.End );
- statements.AddStatement( loopStatement );
- result := TRUE;
- | Scanner.Exit:
- NextSymbol;
- statement := SyntaxTree.NewExitStatement( symbol.position, outer);
- CommentStatement(statement);
- statements.AddStatement( statement );
- result := TRUE;
- | Scanner.Return:
- NextSymbol;
- returnStatement := SyntaxTree.NewReturnStatement( symbol.position, outer);
- CommentStatement(returnStatement);
- IF (Token() >= Scanner.Plus) & (Token() <= Scanner.Identifier) THEN
- expression := Expression();
- returnStatement.SetReturnValue( expression );
- END;
- statements.AddStatement( returnStatement );
- result := TRUE;
- | Scanner.Begin:
- NextSymbol; statement := StatementBlock(outer); statements.AddStatement( statement ); Check( Scanner.End );
- result := TRUE;
- | Scanner.Await:
- awaitStatement := SyntaxTree.NewAwaitStatement( symbol.position, outer );
- CommentStatement(awaitStatement);
- NextSymbol;
- expression := Expression();
- awaitStatement.SetCondition( expression );
- statements.AddStatement( awaitStatement );
- result := TRUE
- | Scanner.Code:
- (* assemble *)
- code := Code(outer);
- Check(Scanner.End);
- statements.AddStatement( code );
- result := TRUE
- | Scanner.End: result := FALSE (* end of if, with, case, while, for, loop, or statement sequence *)
- | Scanner.Until: result := FALSE (* end of repeat *)
- | Scanner.Else: result := FALSE (* else of if or case *)
- | Scanner.Elsif: result := FALSE (* elsif of if *)
- | Scanner.Bar: result := FALSE (* next case *)
- | Scanner.Finally: result := FALSE (* end block by finally statement *)
- | Scanner.Semicolon: result := FALSE (* allow the empty statement *)
- (* builtin pseudo procedures are resolved by checker *)
- ELSE
- result := FALSE;
- (*
- IF Lax THEN
- expression := Expression();
- statement := SyntaxTree.NewAssignment( position, NIL, expression,outer );
- statements.AddStatement(statement);
- result := ~error;
- ELSE
- result := FALSE;
- END;
- *)
- END;
- IF Trace THEN E( "Statement" ) END;
- RETURN result
- END Statement;
- (** StatementSequence = Statement {';' Statement}. **)
- PROCEDURE StatementSequence*(outer: SyntaxTree.Statement ): SyntaxTree.StatementSequence;
- VAR statements: SyntaxTree.StatementSequence; b: BOOLEAN;
- BEGIN
- IF Trace THEN S( "StatementSequence" ) END;
- statements := SyntaxTree.NewStatementSequence();
- IF Lax THEN
- WHILE ~Peek(Scanner.Return) & Statement(statements,outer) DO Ignore(Scanner.Semicolon) END;
- IF Peek(Scanner.Return) & Statement(statements,outer) THEN Ignore(Scanner.Semicolon) END; (* return bound to end of statement sequence *)
- ELSE
- REPEAT
- b := Statement( statements,outer )
- UNTIL ~Optional( Scanner.Semicolon );
- END;
- IF Trace THEN E( "StatementSequence" ) END;
- RETURN statements
- END StatementSequence;
- (** StatementBlock = [Flags] StatementSequence. **)
- PROCEDURE StatementBlock(outer: SyntaxTree.Statement): SyntaxTree.StatementBlock;
- VAR block: SyntaxTree.StatementBlock; position: Position;
- BEGIN
- IF Trace THEN S( "StatementBlock" ) END;
- position := symbol.position;
- position.start := position.end;
- block := SyntaxTree.NewStatementBlock( position, outer );
- CommentStatement(block);
- IF Optional( Scanner.LeftBrace ) THEN
- block.SetModifier(Flags());
- END;
- block.SetStatementSequence( StatementSequence(block) );
- IF Trace THEN E( "StatementBlock" ) END;
- RETURN block
- END StatementBlock;
- (** Code = { any \ 'end' \ 'with' } ['with' {('in'|'out') StatementSequence}] . **)
- PROCEDURE Code(outer: SyntaxTree.Statement): SyntaxTree.Code;
- VAR startPos: Position; endPos, i ,len: LONGINT; codeString: Scanner.StringType; code: SyntaxTree.Code;
- end: Scanner.Token; in, out: BOOLEAN; left, right: SyntaxTree.Identifier;
- statements, rules: SyntaxTree.StatementSequence;
- BEGIN
- startPos := symbol.position;
- end := scanner.SkipToEndOfCode(startPos.start, endPos, symbol);
- IF (end = Scanner.End) OR (end = Scanner.With) THEN
- codeString := symbol.string;
- code := SyntaxTree.NewCode(startPos,outer);
- i := 0; len := LEN(codeString^);
- code.SetSourceCode(codeString,len);
- IF (end = Scanner.With) & Mandatory(Scanner.With) THEN
- in := Optional(Scanner.In);
- out := Optional(Scanner.Out);
- WHILE in OR out DO
- statements := StatementSequence(code);
- IF in THEN rules := code.inRules ELSE rules := code.outRules END;
- FOR i := 0 TO statements.Length()-1 DO
- rules.AddStatement(statements.GetStatement(i));
- END;
- in := Optional(Scanner.In);
- out := Optional(Scanner.Out);
- END;
- END;
- END;
- RETURN code;
- END Code;
- (** Body = 'begin' [Flags] StatementSequence ['finally' StatementSequence]
- | 'code' Code. **)
- PROCEDURE Body( scope: SyntaxTree.ProcedureScope ): SyntaxTree.Body;
- VAR body: SyntaxTree.Body; code: SyntaxTree.Code; position: Position; previousScope: SyntaxTree.Scope;
- BEGIN
- previousScope := currentScope;
- currentScope := scope;
- IF Trace THEN S( "Body" ) END;
- IF Peek( Scanner.Code ) THEN
- body := SyntaxTree.NewBody(symbol.position,scope); (* empty body for the time being *)
- (* assemble *)
- code := Code(body);
- body.SetCode(code);
- ELSIF Mandatory( Scanner.Begin ) THEN
- body := SyntaxTree.NewBody(symbol.position,scope);
- IF Optional( Scanner.LeftBrace ) THEN
- body.SetModifier(Flags());
- END;
- position := symbol.position;
- body.SetStatementSequence(StatementSequence(body));
- IF Optional( Scanner.Finally ) THEN
- body.SetFinally(StatementSequence(body));
- END;
- END;
- IF Trace THEN E( "Body" ) END;
- currentScope := previousScope;
- RETURN body
- END Body;
- (** wrapper for a body in records and modules *)
- PROCEDURE BodyProcedure(parentScope: SyntaxTree.Scope): SyntaxTree.Procedure;
- VAR procedureScope: SyntaxTree.ProcedureScope; procedure: SyntaxTree.Procedure;
- BEGIN
- procedureScope := SyntaxTree.NewProcedureScope(parentScope);
- IF parentScope IS SyntaxTree.ModuleScope THEN
- procedure := SyntaxTree.NewProcedure( symbol.position, Global.ModuleBodyName,procedureScope);
- procedure.SetAccess(SyntaxTree.Hidden);
- ELSE
- procedure := SyntaxTree.NewProcedure( symbol.position, Global.RecordBodyName,procedureScope);
- (*! todo: make this a hidden symbol. Problematic when used with paco. *)
- procedure.SetAccess(SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal);
- END;
- parentScope.AddProcedureDeclaration(procedure);
- procedure.SetType(SyntaxTree.NewProcedureType(SyntaxTree.invalidPosition,parentScope));
- procedure.SetBodyProcedure(TRUE);
- procedureScope.SetBody(Body(procedureScope));
- RETURN procedure
- END BodyProcedure;
- (* ProcedureType = 'procedure' [Flags] [FormalParameters]. *)
- PROCEDURE ProcedureType(position: Position; parentScope: SyntaxTree.Scope): SyntaxTree.ProcedureType;
- VAR procedureType: SyntaxTree.ProcedureType;
- BEGIN
- IF Trace THEN S( "ProcedureType" ) END;
- (* procedure symbol already consumed *)
- procedureType := SyntaxTree.NewProcedureType( position, parentScope);
- IF Optional(Scanner.LeftBrace) THEN
- procedureType.SetModifiers(Flags());
- END;
- IF Optional(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, parentScope) END;
- IF Trace THEN E( "ProcedureType" )
- END;
- RETURN procedureType;
- END ProcedureType;
- (** ObjectType = 'object' | 'object' [Flags] ['(' (QualifiedIdentifier | ArrayType) ')'] DeclarationSequence [Body] 'end' [Identifier] . **)
- PROCEDURE ObjectType(position: Position; name: SyntaxTree.Identifier; parentScope: SyntaxTree.Scope ): SyntaxTree.Type;
- VAR
- objectType: SyntaxTree.RecordType;
- pointerType: SyntaxTree.PointerType;
- recordScope: SyntaxTree.RecordScope;
- qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
- baseType: SyntaxTree.Type;
- identifier: SyntaxTree.Identifier;
- str: Scanner.StringType;
- type: SyntaxTree.Type;
- modifiers: SyntaxTree.Modifier;
- BEGIN
- IF Trace THEN S( "ObjectType" ) END;
- (* symbol object already consumed *)
- (* generic empty OBJECT type *)
- IF Peek(Scanner.Semicolon) OR Peek(Scanner.RightParenthesis) THEN
- Scanner.GetKeyword(scanner.case,Scanner.Object,identifier);
- qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(position,SyntaxTree.invalidIdentifier,identifier);
- type := SyntaxTree.NewQualifiedType( position, parentScope, qualifiedIdentifier );
- RETURN type
- END;
- recordScope := SyntaxTree.NewRecordScope(parentScope);
- pointerType := SyntaxTree.NewPointerType(position,parentScope);
- objectType := SyntaxTree.NewRecordType( position,parentScope,recordScope);
- objectType.IsObject(TRUE);
- objectType.SetPointerType(pointerType);
- pointerType.SetPointerBase(objectType);
- IF Optional(Scanner.LeftBrace) THEN
- modifiers := Flags();
- pointerType.SetModifiers(modifiers);
- END;
- IF Optional( Scanner.LeftParenthesis ) THEN
- IF Optional(Scanner.Array) THEN
- baseType := ArrayType(position, parentScope) (* TODO: correct position? *)
- ELSE
- qualifiedIdentifier := QualifiedIdentifier();
- baseType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier)
- END;
- objectType.SetBaseType(baseType);
- Check( Scanner.RightParenthesis )
- END;
- (*
- IF Optional( Scanner.Implements ) THEN
- REPEAT
- qualifiedIdentifier := QualifiedIdentifier()
- UNTIL ~Optional( Scanner.Comma );
- END;
- *)
- IF Optional( Scanner.Semicolon ) THEN
- (*Warning(symbol.position,Diagnostics.Invalid,"no semicolon allowed here");*)
- END;
- DeclarationSequence( recordScope);
- IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
- recordScope.SetBodyProcedure(BodyProcedure(recordScope));
- END;
- Check(Scanner.End);
- IF ExpectThisIdentifier( name ) THEN
- (* check name not always, reflect in EBNF? *)
- END;
- IF Trace THEN E( "ObjectType" ) END;
- RETURN pointerType
- END ObjectType;
-
- (** CellType = 'cell' [Flags] [PortList] [';'] DeclarationSequence [Body] 'end' [Identifier]
- | 'object'. **)
- PROCEDURE CellType(position: Position; name: SyntaxTree.Identifier; parentScope: SyntaxTree.Scope; isCellNet: BOOLEAN): SyntaxTree.Type;
- VAR
- cellType: SyntaxTree.CellType;
- cellScope: SyntaxTree.CellScope;
- modifiers: SyntaxTree.Modifier;
- qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
- qualifiedType: SyntaxTree.Type;
- BEGIN
- IF Trace THEN S( "CellType" ) END;
- (* symbol cell already consumed *)
- cellScope := SyntaxTree.NewCellScope(parentScope);
- cellType := SyntaxTree.NewCellType( position, parentScope,cellScope);
- cellType.IsCellNet(isCellNet);
- cellScope.SetOwnerCell(cellType);
-
- IF Optional(Scanner.Colon) THEN
- qualifiedIdentifier := QualifiedIdentifier();
- qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
- cellType.SetBaseType( qualifiedType );
- END;
- IF Optional(Scanner.LeftBrace) THEN
- modifiers := Flags();
- cellType.SetModifiers(modifiers);
- END;
- IF Optional( Scanner.LeftParenthesis ) THEN
- PortList(cellType,cellScope);
- END;
- IF Optional( Scanner.Semicolon ) THEN END;
-
- IF Optional(Scanner.Import) THEN ImportList(cellScope) END;
- DeclarationSequence( cellScope);
- IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
- cellScope.SetBodyProcedure(BodyProcedure(cellScope));
- END;
- Check(Scanner.End);
- IF ExpectThisIdentifier( name ) THEN
- (* check name not always, reflect in EBNF? *)
- END;
- IF Trace THEN E( "CellType" ) END;
- RETURN cellType
- END CellType;
- (** PointerType = 'pointer' [Flags] 'to' Type. **)
- PROCEDURE PointerType( position: Position; parentScope: SyntaxTree.Scope ): SyntaxTree.PointerType;
- VAR pointerType: SyntaxTree.PointerType; base: SyntaxTree.Type; modifiers: SyntaxTree.Modifier;
- BEGIN
- IF Trace THEN S( "PointerType" ) END;
- (* pointer symbol already consumed *)
- pointerType := SyntaxTree.NewPointerType( position ,parentScope);
- IF Optional(Scanner.LeftBrace) THEN
- modifiers := Flags();
- pointerType.SetModifiers(modifiers)
- END;
- Check( Scanner.To );
- base := Type(SyntaxTree.invalidIdentifier, parentScope);
- pointerType.SetPointerBase( base );
- IF base IS SyntaxTree.RecordType THEN
- base(SyntaxTree.RecordType).SetPointerType(pointerType);
- END;
- IF Trace THEN E( "PointerType" ) END;
- RETURN pointerType
- END PointerType;
- (**
- RecordType = 'record' [Flags] ['(' QualifiedIdentifier ')'] [VariableDeclaration {';' VariableDeclaration}] 'end'.
- **)
- PROCEDURE RecordType(position: Position; parentScope:SyntaxTree.Scope ): SyntaxTree.RecordType;
- VAR
- recordType: SyntaxTree.RecordType;
- recordScope: SyntaxTree.RecordScope;
- qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; flags: SET; qualifiedType: SyntaxTree.QualifiedType;
- modifier: SyntaxTree.Modifier;
- BEGIN
- IF Trace THEN S( "RecordType" ) END;
- (* record symbol already consumed *)
- flags := {};
- recordScope := SyntaxTree.NewRecordScope(parentScope);
- recordType := SyntaxTree.NewRecordType( position, parentScope, recordScope);
- IF Optional( Scanner.LeftBrace ) THEN
- modifier := Flags();
- recordType.SetModifiers(modifier);
- END;
- IF Optional( Scanner.LeftParenthesis ) THEN
- qualifiedIdentifier := QualifiedIdentifier();
- qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
- recordType.SetBaseType( qualifiedType );
- Check( Scanner.RightParenthesis )
- END;
- IF Lax THEN
- WHILE Peek(Scanner.Identifier) DO VariableDeclaration(recordScope); Ignore(Scanner.Semicolon) END;
- ELSE
- REPEAT
- IF Peek(Scanner.Identifier) THEN VariableDeclaration( recordScope ) END;
- UNTIL ~Optional( Scanner.Semicolon );
- END;
- WHILE Optional(Scanner.Procedure) DO ProcedureDeclaration(recordScope); Ignore(Scanner.Semicolon) END;
- Check( Scanner.End );
- IF Trace THEN E( "RecordType" ) END;
- RETURN recordType
- END RecordType;
- (** ArrayType = 'array' 'of' Type | 'array' Expression {',' Expression} 'of' Type
- | 'array' '[' MathArraySize {',' MathArraySize} ']' ['of' Type].
- MathArraySize = Expression | '*' | '?'.
- **)
- PROCEDURE ArrayType(position: Position; parentScope: SyntaxTree.Scope ): SyntaxTree.Type;
- VAR
- arrayType: SyntaxTree.ArrayType;
- type: SyntaxTree.Type;
- base: SyntaxTree.Type;
- expression: SyntaxTree.Expression;
- PROCEDURE MathArray(): SyntaxTree.Type;
- VAR mathType: SyntaxTree.MathArrayType; base: SyntaxTree.Type;
- BEGIN
- IF Optional(Scanner.Questionmark) THEN
- mathType := SyntaxTree.NewMathArrayType(position,parentScope, SyntaxTree.Tensor);
- ELSIF Optional(Scanner.Times) THEN (* open array *)
- mathType := SyntaxTree.NewMathArrayType(position,parentScope, SyntaxTree.Open);
- ELSE (* size given *)
- mathType := SyntaxTree.NewMathArrayType(position,parentScope, SyntaxTree.Static);
- expression := Expression();
- mathType.SetLength(expression);
- END;
- IF Optional(Scanner.Comma) THEN
- base := MathArray()
- ELSIF Mandatory(Scanner.RightBracket) THEN
- IF Optional( Scanner.Of ) THEN
- base := Type(SyntaxTree.invalidIdentifier , parentScope ); (* base type *)
- END;
- END;
- mathType.SetArrayBase(base);
- RETURN mathType;
- END MathArray;
- BEGIN
- IF Trace THEN S( "ArrayType" ) END;
- (* array symbol already consumed *)
- IF Optional(Scanner.LeftBracket) THEN (* math array *)
- type := MathArray();
- ELSIF Optional( Scanner.Of ) THEN (* open array *)
- arrayType := SyntaxTree.NewArrayType(position,parentScope, SyntaxTree.Open);
- type := arrayType;
- base := Type( SyntaxTree.invalidIdentifier ,parentScope);
- arrayType.SetArrayBase( base )
- ELSE (* static array *)
- arrayType := SyntaxTree.NewArrayType(position,parentScope, SyntaxTree.Static);
- type := arrayType;
- expression := SimpleExpression();
- arrayType.SetLength( expression );
- position := symbol.position;
- IF Optional( Scanner.Comma ) THEN
- base := ArrayType( position,parentScope);
- arrayType.SetArrayBase( base )
- ELSIF Mandatory( Scanner.Of ) THEN
- base := Type(SyntaxTree.invalidIdentifier , parentScope ); (* base type *)
- arrayType.SetArrayBase( base );
- END;
- END;
- IF Trace THEN E( "ArrayType" ) END;
- RETURN type
- END ArrayType;
- (** EnumerationType = 'enum' ['('QualifiedIdentifier')'] IdentifierDefinition ['=' Expression]
- {',' IdentifierDefinition ['=' Expression]} 'end'. *)
- PROCEDURE EnumerationType(position: Position; parentScope: SyntaxTree.Scope): SyntaxTree.Type;
- VAR type: SyntaxTree.EnumerationType; scope: SyntaxTree.EnumerationScope; identifier: SyntaxTree.Identifier;
- qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; qualifiedType: SyntaxTree.QualifiedType; access: SET;
- constant: SyntaxTree.Constant; expression: SyntaxTree.Expression;
- BEGIN
- (* enum symbol already consumed *)
- scope := SyntaxTree.NewEnumerationScope(parentScope);
- type := SyntaxTree.NewEnumerationType(position,parentScope, scope);
- IF Optional( Scanner.LeftParenthesis ) THEN
- qualifiedIdentifier := QualifiedIdentifier();
- qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
- type.SetEnumerationBase( qualifiedType );
- Check( Scanner.RightParenthesis )
- END;
- REPEAT
- IdentifierDefinition(identifier,access,FALSE);
- position := symbol.position;
- constant := SyntaxTree.NewConstant( position, identifier );
- CommentSymbol(constant);
- constant.SetAccess(access);
- IF Optional(Scanner.Equal) THEN
- expression := Expression();
- constant.SetValue( expression );
- END;
- scope.AddConstant( constant );
- UNTIL ~Optional(Scanner.Comma);
- IF Mandatory(Scanner.End) THEN END;
- RETURN type
- END EnumerationType;
- (** PortType = 'port' ('in'|'out') ['(' Expression ')'] *)
- PROCEDURE PortType(position: Position; parentScope: SyntaxTree.Scope): SyntaxTree.Type;
- VAR type: SyntaxTree.Type; direction: LONGINT; sizeExpression: SyntaxTree.Expression;
- BEGIN
- (* port symbol already consumed *)
- IF Optional(Scanner.In) THEN
- direction := SyntaxTree.InPort
- ELSIF Optional(Scanner.Out) THEN
- direction := SyntaxTree.OutPort
- ELSE
- Error(position,Diagnostics.Invalid,"invalid direction, expected IN or OUT");
- END;
- IF Optional(Scanner.LeftParenthesis) THEN
- sizeExpression := Expression();
- IF Mandatory(Scanner.RightParenthesis )THEN END;
- END;
- type := SyntaxTree.NewPortType(position, direction, sizeExpression, parentScope);
- RETURN type
- END PortType;
- (** Type = ArrayType | RecordType | PointerType | ObjectType | CellType | CellnetType | PortType
- | ProcedureType | EnumerationType | QualifiedIdentifier. *)
- PROCEDURE Type( name: SyntaxTree.Identifier; parentScope: SyntaxTree.Scope ): SyntaxTree.Type;
- VAR type: SyntaxTree.Type; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; position: Position;
- BEGIN
- IF Trace THEN S( "Type" ) END;
- position := symbol.position;
- IF Optional( Scanner.Array ) THEN type := ArrayType( position,parentScope );
- ELSIF Optional( Scanner.Record ) THEN type := RecordType( position,parentScope );
- ELSIF Optional( Scanner.Pointer ) THEN type := PointerType( position,parentScope );
- ELSIF Optional( Scanner.Object ) THEN type := ObjectType( position,name,parentScope );
- ELSIF Optional( Scanner.Cell) THEN type := CellType( position, name, parentScope,FALSE);
- ELSIF Optional( Scanner.CellNet) THEN type := CellType( position, name, parentScope, TRUE);
- ELSIF Optional( Scanner.Port) THEN type := PortType( position, parentScope)
- ELSIF Optional( Scanner.Procedure ) THEN type := ProcedureType( position,parentScope);
- ELSIF Optional( Scanner.Enum ) THEN type := EnumerationType( position,parentScope);
- ELSIF (Token() = Scanner.Address) OR (Token() = Scanner.Size) THEN
- qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(position,SyntaxTree.invalidIdentifier, symbol.identifier);
- type := SyntaxTree.NewQualifiedType( qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
- NextSymbol;
- ELSE qualifiedIdentifier := QualifiedIdentifier();
- type := SyntaxTree.NewQualifiedType( qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
- END;
- IF Trace THEN E( "Type" ) END;
- RETURN type
- END Type;
- (** PortDeclaration = Identifier [Flags] {',' Identifier [Flags]}':' Type. **)
- PROCEDURE PortDeclaration(cell: SyntaxTree.CellType; parentScope: SyntaxTree.Scope);
- VAR
- type: SyntaxTree.Type; name: SyntaxTree.Identifier;
- firstParameter, parameter: SyntaxTree.Parameter;
- position: Position; modifiers: SyntaxTree.Modifier;
- BEGIN
- IF Trace THEN S( "PortDeclaration" ) END;
- firstParameter := cell.lastParameter;
- REPEAT
- name := Identifier(position);
- parameter := SyntaxTree.NewParameter(position,cell,name,SyntaxTree.ValueParameter);
- cell.AddParameter(parameter);
- IF Optional(Scanner.LeftBrace) THEN
- modifiers := Flags();
- parameter.SetModifiers(modifiers);
- END;
- UNTIL ~Optional( Scanner.Comma );
- Check( Scanner.Colon );
- type := Type( SyntaxTree.invalidIdentifier, parentScope);
- ASSERT(type # NIL);
- IF firstParameter # NIL THEN parameter := firstParameter.nextParameter ELSE parameter := cell.firstParameter END;
- WHILE parameter # NIL DO
- parameter.SetType( type );
- parameter := parameter.nextParameter;
- END;
- IF Trace THEN E( "PortDeclaration" )
- END;
- END PortDeclaration;
- (** PortList = '(' [PortDeclaration {';' PortDeclaration}] ')'. **)
- PROCEDURE PortList( cell: SyntaxTree.CellType ; parentScope: SyntaxTree.Scope);
- BEGIN
- IF Trace THEN S( "PortList" ) END;
- (* left parenthesis already consumed *)
- IF ~Optional( Scanner.RightParenthesis ) THEN
- IF Lax THEN
- WHILE Peek(Scanner.Identifier) OR Peek(Scanner.Var) OR Peek(Scanner.Const) DO PortDeclaration( cell, parentScope ); Ignore(Scanner.Semicolon) END;
- ELSE
- REPEAT PortDeclaration( cell, parentScope ); UNTIL ~Optional( Scanner.Semicolon );
- END;
- Check( Scanner.RightParenthesis );
- END;
- IF Trace THEN E( "PortList" ) END;
- END PortList;
- (** ParameterDeclaration = ['var'|'const'] Identifier [Flags] ['= Expression] {',' Identifier [Flags] ['= Expression]}':' Type.**)
- PROCEDURE ParameterDeclaration( procedureType: SyntaxTree.ProcedureType ; parentScope: SyntaxTree.Scope);
- VAR
- type: SyntaxTree.Type; name: SyntaxTree.Identifier;
- firstParameter, parameter: SyntaxTree.Parameter; kind: LONGINT; position: Position;
- BEGIN
- IF Trace THEN S( "ParameterDeclaration" ) END;
- IF Optional( Scanner.Var ) THEN (* var parameter *)
- kind := SyntaxTree.VarParameter
- ELSIF Optional( Scanner.Const ) THEN (* const parameter *)
- kind := SyntaxTree.ConstParameter
- ELSIF Token() # Scanner.Identifier THEN
- Error(symbol.position,Scanner.Identifier,"");
- RETURN
- ELSE kind := SyntaxTree.ValueParameter
- END;
- firstParameter := procedureType.lastParameter;
- REPEAT
- name := Identifier(position);
- parameter := SyntaxTree.NewParameter(position,procedureType,name,kind);
- IF Optional(Scanner.LeftBrace) THEN parameter.SetModifiers(Flags()) END;
- procedureType.AddParameter(parameter);
- IF Optional(Scanner.Equal) THEN
- parameter.SetDefaultValue(Expression());
- END
- UNTIL ~Optional( Scanner.Comma );
- Check( Scanner.Colon );
- type := Type( SyntaxTree.invalidIdentifier, parentScope);
- CommentSymbol(parameter);
- ASSERT(type # NIL);
- IF firstParameter # NIL THEN parameter := firstParameter.nextParameter ELSE parameter := procedureType.firstParameter END;
- WHILE parameter # NIL DO
- parameter.SetType( type );
- parameter := parameter.nextParameter;
- END;
- IF Trace THEN E( "ParameterDeclaration" )
- END;
- END ParameterDeclaration;
- (** FormalParameters = '(' [ParameterDeclaration {';' ParameterDeclaration}] ')' [':' [Flags] Type]. **)
- PROCEDURE FormalParameters( procedureType: SyntaxTree.ProcedureType ; parentScope: SyntaxTree.Scope);
- VAR type: SyntaxTree.Type; position: Position;
- BEGIN
- IF Trace THEN S( "FormalParameters" ) END;
- (* left parenthesis already consumed *)
- IF ~Optional( Scanner.RightParenthesis ) THEN
- IF Lax THEN
- WHILE Peek(Scanner.Identifier) OR Peek(Scanner.Const) OR Peek(Scanner.Var) DO
- ParameterDeclaration(procedureType, parentScope); Ignore(Scanner.Semicolon)
- END;
- ELSE
- REPEAT ParameterDeclaration( procedureType, parentScope ); UNTIL ~Optional( Scanner.Semicolon );
- END;
- Check( Scanner.RightParenthesis );
- END;
- IF Optional( Scanner.Colon ) THEN
- position:= symbol.position;
- IF Optional( Scanner.LeftBrace) THEN
- procedureType.SetReturnTypeModifiers(Flags());
- END;
- type := Type(SyntaxTree.invalidIdentifier,parentScope);
- (* formally, any type is permitted as return type. Actually some of them might simply not be usable *)
- procedureType.SetReturnType(type);
- END;
- IF Trace THEN E( "FormalParameters" ) END;
- END FormalParameters;
- (** Flags = '{' [Identifier ['(' Expression ')'|'=' Expression] {',' Identifier ['(' Expression ')' | '=' Expression ] } ] '}'. **)
- PROCEDURE Flags(): SyntaxTree.Modifier;
- VAR identifier: SyntaxTree.Identifier; modifier,list: SyntaxTree.Modifier; position: Position; expression: SyntaxTree.Expression;
- BEGIN
- IF Trace THEN S( "Flags" ) END;
- (* left brace already consumed *)
- list := NIL;
- IF Peek(Scanner.RightBrace) THEN (* empty flags *)
- ELSE
- REPEAT
- position := symbol.position;
- identifier := Identifier(position);
- IF Optional(Scanner.LeftParenthesis) THEN
- expression := Expression();
- Check(Scanner.RightParenthesis)
- ELSIF Optional(Scanner.Equal) THEN
- expression := Expression();
- ELSE
- expression := NIL
- END;
- modifier := SyntaxTree.NewModifier(position,identifier,expression);
- AppendModifier(list,modifier);
- UNTIL ~Optional( Scanner.Comma ) & ~Optional(Scanner.Semicolon);
- END;
- Check(Scanner.RightBrace);
- IF Trace THEN E( "Flags" ) END;
- RETURN list;
- END Flags;
- PROCEDURE SetNextInComment(c: SyntaxTree.Comment; this: ANY);
- BEGIN
- WHILE c # NIL DO
- c.SetItem(this,FALSE);
- c := c.nextComment
- END;
- END SetNextInComment;
- PROCEDURE CommentSymbol(symbol: SyntaxTree.Symbol);
- BEGIN
- IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
- symbol.SetComment(recentComment);
- SetNextInComment(recentComment, symbol);
- recentComment := NIL
- END;
- recentLine := scanner.position.line;
- recentCommentItem := symbol;
- END CommentSymbol;
- PROCEDURE CommentStatement(symbol: SyntaxTree.Statement);
- BEGIN
- IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
- symbol.SetComment(recentComment);
- SetNextInComment(recentComment, symbol);
- recentComment := NIL
- END;
- recentLine := scanner.position.line;
- recentCommentItem := symbol
- END CommentStatement;
- PROCEDURE CommentCasePart(symbol: SyntaxTree.CasePart);
- BEGIN
- IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
- symbol.SetComment(recentComment);
- SetNextInComment(recentComment, symbol);
- recentComment := NIL
- END;
- recentLine := scanner.position.line;
- recentCommentItem := symbol
- END CommentCasePart;
- PROCEDURE CommentIfPart(symbol: SyntaxTree.IfPart);
- BEGIN
- IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
- symbol.SetComment(recentComment);
- SetNextInComment(recentComment, symbol);
- recentComment := NIL
- END;
- recentLine := scanner.position.line;
- recentCommentItem := symbol
- END CommentIfPart;
- PROCEDURE CommentWithPart(symbol: SyntaxTree.WithPart);
- BEGIN
- IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
- symbol.SetComment(recentComment);
- SetNextInComment(recentComment, symbol);
- recentComment := NIL
- END;
- recentLine := scanner.position.line;
- recentCommentItem := symbol
- END CommentWithPart;
- (** ProcedureDeclaration = 'procedure' ['^'|'&'|'~'|'-'|Flags ['-']] IdentifierDefinition [FormalParameters]';'
- DeclarationSequence [Body] 'end' Identifier.
- Forward declarations ignored.
- **)
- PROCEDURE ProcedureDeclaration( parentScope: SyntaxTree.Scope);
- VAR name: SyntaxTree.Identifier;
- procedure: SyntaxTree.Procedure;
- procedureType: SyntaxTree.ProcedureType;
- procedureScope : SyntaxTree.ProcedureScope;
- access: SET;
- position: Position;
- isConstructor: BOOLEAN;
- isFinalizer: BOOLEAN;
- isInline: BOOLEAN;
- modifiers: SyntaxTree.Modifier;
- forwardDeclaration: BOOLEAN;
- string: Scanner.StringType;
- parameter: SyntaxTree.Parameter;
- qualifiedIdentifier : SyntaxTree.QualifiedIdentifier;
- identifier: SyntaxTree.Identifier;
- kind: LONGINT;
- BEGIN
- IF Trace THEN S( "Procedure" ) END;
- (* symbol procedure has already been consumed *)
- modifiers := NIL;
- isConstructor := FALSE; isFinalizer := FALSE; isInline := FALSE;
- procedureType := SyntaxTree.NewProcedureType(symbol.position, parentScope);
- position := symbol.position;
- IF Optional( Scanner.Arrow) THEN (* ignore forward declarations *)
- forwardDeclaration := TRUE;
- ELSE forwardDeclaration := FALSE;
- END;
- IF Optional( Scanner.And ) THEN (* constructor *)
- isConstructor := TRUE
- ELSIF Optional( Scanner.Not ) THEN (* finalizer *)
- isFinalizer := TRUE
- ELSIF Optional( Scanner.Minus ) THEN (* inline *)
- isInline := TRUE;
- ELSIF Optional( Scanner.LeftBrace) THEN
- modifiers := Flags();
- IF Optional( Scanner.Minus ) THEN (* inline *)
- isInline := TRUE
- END;
- END;
- IF Peek(Scanner.String) OR Peek(Scanner.Character) THEN (* for compatibility with release *)
- Error (position, Diagnostics.Invalid, "Invalid operator declaration: replace 'procedure' by 'operator' keyword!");
- OperatorDeclaration( parentScope );
- RETURN
- END;
-
- procedureScope := SyntaxTree.NewProcedureScope(parentScope);
- IF Optional(Scanner.LeftParenthesis) THEN (* type bound *)
- IF Optional(Scanner.Var) THEN
- kind := SyntaxTree.VarParameter
- ELSIF Optional(Scanner.Const) THEN
- kind := SyntaxTree.ConstParameter;
- ELSE
- kind := SyntaxTree.ConstParameter;
- END;
- identifier := Identifier(position);
- parameter := SyntaxTree.NewParameter(position, procedureType, identifier, kind);
- Check(Scanner.Colon);
- qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(position, SyntaxTree.invalidIdentifier, Identifier(position));
- parameter.SetType(SyntaxTree.NewQualifiedType(position, procedureScope, qualifiedIdentifier));
- Check(Scanner.RightParenthesis);
- procedureType.SetSelfParameter(parameter);
- parameter.SetSelfParameter(TRUE);
- END;
- position:= symbol.position;
- IdentifierDefinition( name, access,TRUE);
- procedure := SyntaxTree.NewProcedure( position, name, procedureScope);
- procedure.SetConstructor(isConstructor);
- procedure.SetFinalizer(isFinalizer);
- procedure.SetInline(isInline);
- CommentSymbol(procedure);
- procedure.SetAccess(access);
- procedureType.SetModifiers(modifiers);
- procedure.SetType(procedureType);
- IF Optional(Scanner.Extern) & MandatoryString(string) THEN procedure.SetExternalName(string); END;
- IF Optional(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, procedureScope) END;
- IF (procedure.externalName = NIL) & ~forwardDeclaration THEN
- IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
- DeclarationSequence( procedureScope);
- IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
- procedureScope.SetBody(Body(procedureScope));
- END;
- Check(Scanner.End);
- IF ExpectThisIdentifier( name ) THEN END;
- END;
- parentScope.AddProcedureDeclaration( procedure );
- IF Trace THEN E( "Procedure") END;
- END ProcedureDeclaration;
- (** OperatorDeclaration = 'operator' [Flags] ['-'] String ['*'|'-'] FormalParameters ';'
- DeclarationSequence [Body] 'end' String.
- **)
- PROCEDURE OperatorDeclaration(parentScope: SyntaxTree.Scope );
- VAR
- string: Scanner.StringType;
- procedureScope: SyntaxTree.ProcedureScope;
- procedureType: SyntaxTree.ProcedureType;
- operator: SyntaxTree.Operator;
- access: SET;
- i: LONGINT; ch: CHAR; position: Position;
- modifiers: SyntaxTree.Modifier; (* nopov *)
- isInline, forward: BOOLEAN;
- BEGIN
- IF Trace THEN S( "Operator" ) END;
- (* symbol operator already consumed *)
- position := symbol.position;
- forward := Optional(Scanner.Arrow);
- isInline := FALSE;
-
- IF Optional( Scanner.LeftBrace) THEN
- modifiers := Flags();
- END;
- IF Optional( Scanner.Minus ) THEN (* inline *)
- isInline := TRUE;
- END;
- IF MandatoryString( string ) THEN
- (* copy string to name and check for length. LEN(name)>0, LEN(string)>0 can be presumed *)
- i := 0; WHILE (string^[i] # 0X) DO INC(i) END;
- IF i >= Scanner.MaxIdentifierLength THEN (* string too long to act as operator identifier *)
- Error(symbol.position,Basic.StringTooLong,"");
- END
- END;
- IF Optional( Scanner.Times ) THEN access := SyntaxTree.ReadOnly;
- ELSIF Optional( Scanner.Minus ) THEN access := SyntaxTree.ReadOnly;
- ELSE access := SyntaxTree.Internal;
- END;
-
- procedureScope := SyntaxTree.NewProcedureScope(parentScope);
- operator := SyntaxTree.NewOperator( symbol.position, SyntaxTree.NewIdentifier(string^), procedureScope);
- CommentSymbol(operator);
- operator.SetAccess(access);
- procedureType := SyntaxTree.NewProcedureType(symbol.position,parentScope);
- IF Mandatory(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, procedureScope ) END;
- procedureType.SetModifiers(modifiers); (* nopov *)
- operator.SetType( procedureType );
- operator.SetInline(isInline);
- IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
- IF ~forward THEN
- DeclarationSequence( procedureScope );
- IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
- procedureScope.SetBody(Body(procedureScope));
- END;
- IF Mandatory(Scanner.End) & ExpectThisString(string^) THEN END;
- END;
- parentScope.AddProcedureDeclaration(operator);
- IF parentScope IS SyntaxTree.ModuleScope THEN
- parentScope(SyntaxTree.ModuleScope).AddOperator(operator);
- ELSIF parentScope IS SyntaxTree.RecordScope THEN
- parentScope(SyntaxTree.RecordScope).AddOperator(operator);
- ELSE
- Error(position,Diagnostics.Invalid,"Operators only allowed in module or record scope"); (* nopov *)
- END;
- IF Trace THEN EE( "Operator", string^ ) END;
- END OperatorDeclaration;
- (** VariableNameList = IdentifierDefinition [Flags] [':=' Expression | 'extern' String] {',' IdentifierDefinition [Flags] [':=' Expression | 'extern' String] }.**)
- PROCEDURE VariableNameList( scope: SyntaxTree.Scope );
- VAR varname: SyntaxTree.Identifier; position: Position; variable: SyntaxTree.Variable; flags,access: SET; string: Scanner.StringType;
- BEGIN
- IF Trace THEN S( "VariableNameList" ) END;
- REPEAT
- flags := {};
- position := symbol.position;
- IdentifierDefinition( varname, access,TRUE);
- variable := SyntaxTree.NewVariable( position, varname );
- CommentSymbol(variable);
- IF Optional(Scanner.LeftBrace) THEN variable.SetModifiers(Flags()) END;
- IF Optional(Scanner.Becomes) THEN variable.SetInitializer (Expression());
- ELSIF Optional(Scanner.Extern) & MandatoryString(string) THEN variable.SetExternalName(string); END;
- variable.SetAccess(access);
- scope.AddVariable(variable);
- UNTIL ~Optional( Scanner.Comma );
- IF Trace THEN E( "VariableNameList" ) END;
- END VariableNameList;
- (** VariableDeclaration = VariableNameList ':' Type. **)
- PROCEDURE VariableDeclaration(parentScope: SyntaxTree.Scope );
- VAR
- variable, firstVariable: SyntaxTree.Variable; type: SyntaxTree.Type;
- BEGIN
- IF Trace THEN S( "VariableDeclaration" ) END;
- firstVariable := parentScope.lastVariable;
- VariableNameList( parentScope );
- Check( Scanner.Colon );
- type := Type( SyntaxTree.invalidIdentifier, parentScope );
- variable := firstVariable;
- IF firstVariable # NIL THEN variable := firstVariable.nextVariable ELSE variable := parentScope.firstVariable END;
- WHILE variable # NIL DO
- variable.SetType( type );
- variable := variable.nextVariable;
- END;
- IF Trace THEN E( "VariableDeclaration" ) END;
- END VariableDeclaration;
- (** TypeDeclaration = IdentifierDefinition '=' Type.**)
- PROCEDURE TypeDeclaration(parentScope: SyntaxTree.Scope);
- VAR name: SyntaxTree.Identifier; position: Position; type: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration; access: SET;
- BEGIN
- IF Trace THEN S( "TypeDeclaration" ) END;
- position := symbol.position;
- IdentifierDefinition( name, access,FALSE);
- typeDeclaration := SyntaxTree.NewTypeDeclaration( position,name);
- CommentSymbol(typeDeclaration);
- Check( Scanner.Equal );
- type := Type( name , parentScope);
- type.SetTypeDeclaration(typeDeclaration);
- typeDeclaration.SetDeclaredType(type);
- (*
- type.SetName(typeDeclaration.name); (* don't do that: overwrites global names ! *)
- *)
- typeDeclaration.SetAccess(access);
- parentScope.AddTypeDeclaration( typeDeclaration );
- IF Trace THEN E( "TypeDeclaration" ) END;
- END TypeDeclaration;
- (** ConstDeclaration = IdentifierDefinition '=' Expression. **)
- PROCEDURE ConstDeclaration(parentScope: SyntaxTree.Scope );
- VAR name: SyntaxTree.Identifier; position: Position; constant: SyntaxTree.Constant; expression: SyntaxTree.Expression; access: SET;
- BEGIN
- IF Trace THEN S( "ConstDeclaration" ) END;
- IdentifierDefinition( name, access, FALSE);
- position := symbol.position;
- constant := SyntaxTree.NewConstant( position, name );
- CommentSymbol(constant);
- constant.SetAccess(access);
- Check( Scanner.Equal );
- expression := Expression();
- constant.SetValue( expression );
- parentScope.AddConstant( constant );
- IF Trace THEN E( "ConstDeclaration" ) END;
- END ConstDeclaration;
- (** DeclarationSequence = { 'const' [ConstDeclaration] {';' [ConstDeclaration]}
- |'type' [TypeDeclaration] {';' [TypeDeclaration]}
- |'var' [VariableDeclaration] {';' [VariableDeclaration]}
- | ProcedureDeclaration
- | OperatorDeclaration
- | ';'
- }
- **)
- PROCEDURE DeclarationSequence( parentScope: SyntaxTree.Scope);
- VAR previousScope: SyntaxTree.Scope;
- BEGIN
- previousScope := currentScope;
- currentScope := parentScope;
- IF Trace THEN S( "DeclarationSequence" ) END;
- IF Lax THEN
- LOOP
- Ignore(Scanner.Semicolon);
- IF Optional(Scanner.Const) THEN
- WHILE Peek(Scanner.Identifier) DO ConstDeclaration(parentScope); Ignore(Scanner.Semicolon) END;
- ELSIF Optional(Scanner.Type) THEN
- WHILE Peek(Scanner.Identifier) DO TypeDeclaration(parentScope); Ignore(Scanner.Semicolon) END;
- ELSIF Optional(Scanner.Var) THEN
- WHILE Peek(Scanner.Identifier) DO VariableDeclaration(parentScope); Ignore(Scanner.Semicolon); END;
- ELSIF Optional(Scanner.Procedure) THEN
- ProcedureDeclaration(parentScope); Ignore(Scanner.Semicolon)
- ELSIF Optional(Scanner.Operator) THEN
- OperatorDeclaration(parentScope); Ignore(Scanner.Semicolon);
- ELSE
- EXIT
- END;
- END;
- ELSE
- LOOP
- IF Optional( Scanner.Const ) THEN
- REPEAT
- IF Peek(Scanner.Identifier) THEN ConstDeclaration( parentScope ) END
- UNTIL ~Optional( Scanner.Semicolon )
- ELSIF Optional( Scanner.Type ) THEN
- REPEAT
- IF Peek(Scanner.Identifier) THEN TypeDeclaration( parentScope) END
- UNTIL ~Optional( Scanner.Semicolon )
- ELSIF Optional( Scanner.Var ) THEN
- REPEAT
- IF Peek(Scanner.Identifier) THEN VariableDeclaration( parentScope ) END
- UNTIL ~Optional( Scanner.Semicolon )
- ELSIF Optional(Scanner.Operator) THEN
- OperatorDeclaration( parentScope);
- ELSIF Optional( Scanner.Procedure ) THEN
- ProcedureDeclaration( parentScope );
- ELSE EXIT
- END;
- Ignore(Scanner.Semicolon)
- END;
- END;
- currentScope := previousScope;
- IF Trace THEN E( "DeclarationSequence" ) END;
- END DeclarationSequence;
- (**
- ImportList = 'import' Import { ',' Import } ';'.
- Import = Identifier [':=' Identifier] ['in' Identifier].
- **)
- PROCEDURE ImportList( scope: SyntaxTree.Scope );
- VAR alias, name, context: SyntaxTree.Identifier; import: SyntaxTree.Import; position, idPosition: Position;
- BEGIN
- IF Trace THEN S( "ImportList" ) END;
- (* import symbol already consumed *)
- REPEAT
- alias := Identifier(idPosition);
- position := symbol.position;
- IF alias # SyntaxTree.invalidIdentifier THEN
- IF Optional( Scanner.Becomes ) THEN name := Identifier(idPosition) ELSE name := alias; END;
- import := SyntaxTree.NewImport( position, alias, name, TRUE );
- CommentSymbol(import);
- IF Optional(Scanner.In) THEN
- position := symbol.position;
- context := Identifier(idPosition);
- IF context # SyntaxTree.invalidIdentifier THEN import.SetContext(context) END;
- END;
- WITH scope: SyntaxTree.ModuleScope DO
- scope.AddImport( import );
- | scope: SyntaxTree.CellScope DO
- scope.AddImport( import );
- END;
- END;
- UNTIL ~Optional( Scanner.Comma );
- IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
- IF Trace THEN E( "ImportList" ); END;
- END ImportList;
- (** Module = ('module' | 'cellnet' [Flags]) Identifier ['in' Identifier]';'
- [ImportList] DeclarationSequence [Body]
- 'end' Identifier '.'.
- **)
- PROCEDURE Module*(): SyntaxTree.Module;
- VAR moduleName, context: SyntaxTree.Identifier; module: SyntaxTree.Module; position: Position; isCellNet: BOOLEAN;
- scannerDiagnostics: Diagnostics.Diagnostics; modifiers: SyntaxTree.Modifier; c: SyntaxTree.Comment;
- BEGIN
- IF Trace THEN S( "Module" ) END;
- position := symbol.position;
- moduleScope := SyntaxTree.NewModuleScope(); (* needed to feed in comment already before module starts *)
- currentScope := moduleScope;
- isCellNet := Optional(Scanner.CellNet);
- IF isCellNet OR Mandatory( Scanner.Module ) THEN
- (*c := recentComment; recentComment := NIL;*)
- IF isCellNet & Optional(Scanner.LeftBrace) THEN modifiers := Flags() ELSE modifiers := NIL END;
- moduleName := Identifier(position);
- module := SyntaxTree.NewModule( scanner.source^, position, moduleName, moduleScope, scanner.case );
- CommentSymbol(module);
- (*
- module.SetComment(c);
- SetNextInComment(c, module);
- *)
- IF isCellNet THEN module.SetCellNet(TRUE); module.SetModifiers(modifiers); END;
- module.SetType(SyntaxTree.moduleType);
- IF Optional(Scanner.In) THEN
- position := symbol.position;
- context := Identifier(position);
- module.SetContext(context);
- END;
- IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check(Scanner.Semicolon) END;
- IF ~Peek(Scanner.EndOfText) THEN
- module.SetClosingComment(recentComment);
- SetNextInComment(recentComment, module);
- recentComment := NIL;
- END;
- IF Optional(Scanner.Import) THEN ImportList(moduleScope) END;
- DeclarationSequence( moduleScope);
- IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
- moduleScope.SetBodyProcedure(BodyProcedure(moduleScope)); (* insert empty body procedure if necessary *)
- END;
- Check(Scanner.End);
- IF ExpectThisIdentifier( moduleName ) THEN
- IF Token() # Scanner.Period THEN
- Error( symbol.position, Scanner.Period, "" )
- ELSIF ~error & ~scanner.error THEN (* read ahead to read comments and to check for next module *)
- scanner.ResetCase;
- scannerDiagnostics := NIL;
- scanner.ResetErrorDiagnostics(scannerDiagnostics);
- NextSymbol;
- scanner.ResetErrorDiagnostics(scannerDiagnostics);
- END;
- (*
- (* do not use Check for not reading after end of module *)
- IF ~Peek(Scanner.Module) & ~Peek(Scanner.CellNet) THEN
- SetNextInComment(recentComment,module);
- module.SetClosingComment(recentComment);
- recentComment := NIL;
- END;
- *)
- END;
- END;
- IF Trace THEN E( "Module" ) END;
- RETURN module
- END Module;
- (** check if another module declaration is available after recent module parsing -> for parsing and compiling multiple modules within a single file **)
- PROCEDURE NextModule*(): BOOLEAN;
- BEGIN
- RETURN Peek(Scanner.Module) OR Peek(Scanner.CellNet);
- END NextModule;
- END Parser;
- (* utilities *)
- PROCEDURE AppendModifier(VAR list: SyntaxTree.Modifier; modifier: SyntaxTree.Modifier);
- VAR this, next: SyntaxTree.Modifier;
- BEGIN
- IF list = NIL THEN list := modifier
- ELSE
- this := list;
- next := list.nextModifier;
- WHILE next # NIL DO
- this := next;
- next := this.nextModifier;
- END;
- this.SetNext(modifier);
- END;
- END AppendModifier;
- (** parser retrieval **)
- PROCEDURE NewParser*( scanner: Scanner.Scanner; diagnostics: Diagnostics.Diagnostics): Parser;
- VAR parser: Parser;
- BEGIN
- NEW( parser, scanner, diagnostics ); RETURN parser;
- END NewParser;
- END FoxParser.
|