1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482 |
- 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, Streams, Strings, StringPool;
- 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;
- prevPosition-: Position;
- (* conditional compilation *)
- CONST Processing = 0; ProcessingElse = 1; Skipping = 2; Ignoring = 3; IgnoringElse = 4;
- VAR conditional: WORD;
- VAR conditionals: ARRAY 10 OF WORD;
- VAR definitions: ARRAY 10 OF Scanner.IdentifierType;
- VAR conditionalCount, definitionCount: SIZE;
- 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; CONST definitions: ARRAY OF CHAR );
- VAR begin, end: LONGINT (* SIZE! *); definition: ARRAY 32 OF CHAR;
- BEGIN
- conditional := Processing;
- conditionalCount := 0;
- definitionCount := 0;
- begin := 0;
- REPEAT
- end := Strings.Find (definitions, begin, ',');
- IF end # -1 THEN
- Strings.Copy (definitions, begin, end - begin, definition);
- begin := end + 1;
- ELSE
- Strings.Copy (definitions, begin, Strings.Length (definitions) - begin, definition);
- END;
- IF definition # "" THEN
- StringPool.GetIndex (definition, SELF.definitions[definitionCount]);
- INC (definitionCount);
- END;
- UNTIL end = -1;
- SELF.scanner := scanner;
- SELF.diagnostics := diagnostics;
- error := ~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;
- (* conditional compilation according to the following syntax *)
- (* Block = '#' 'if' Condition 'then' Block { '#' 'elsif' Condition 'then' Block } ['#' 'else' Block] '#' 'end' | any token until next new line. *)
- PROCEDURE GetNextSymbol(VAR symbol: Scanner.Symbol): BOOLEAN;
- VAR line: Streams.Position;
- BEGIN
- LOOP
- line := symbol.position.line;
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF (symbol.token = Scanner.Unequal) & (symbol.position.line # line) THEN
- IF ~ConditionalStatement (symbol) THEN RETURN FALSE END;
- ELSIF (conditional = Processing) OR (conditional = ProcessingElse) THEN
- RETURN TRUE;
- END;
- END;
- END GetNextSymbol;
- PROCEDURE ConditionalStatement(VAR symbol: Scanner.Symbol): BOOLEAN;
- VAR value: BOOLEAN;
- (* Factor = Identifier | '~' Factor | '(' Condition ')'. *)
- PROCEDURE Factor (VAR value: BOOLEAN): BOOLEAN;
- VAR i: SIZE;
- BEGIN
- IF symbol.token = Scanner.Identifier THEN
- value := FALSE; i := 0;
- WHILE (i # definitionCount) & ~value DO value := symbol.identifier = definitions[i]; INC (i) END;
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- ELSIF symbol.token = Scanner.Not THEN
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF ~Factor (value) THEN RETURN FALSE END;
- value := ~value;
- ELSIF symbol.token = Scanner.LeftParenthesis THEN
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF ~Condition (value) THEN RETURN FALSE END;
- IF symbol.token # Scanner.RightParenthesis THEN Error (symbol.position, Scanner.RightParenthesis, ""); RETURN FALSE END;
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- ELSE
- Error (symbol.position, Scanner.Identifier, ""); RETURN FALSE;
- END;
- RETURN TRUE;
- END Factor;
- (* Term = Factor {'&' Factor}. *)
- PROCEDURE Term (VAR value: BOOLEAN): BOOLEAN;
- VAR next: BOOLEAN;
- BEGIN
- IF ~Factor (value) THEN RETURN FALSE END;
- WHILE symbol.token = Scanner.And DO
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF ~Factor (next) THEN RETURN FALSE END;
- IF ~next THEN value := FALSE END;
- END;
- RETURN TRUE;
- END Term;
- (* Condition = Term {'or' Term}. *)
- PROCEDURE Condition (VAR value: BOOLEAN): BOOLEAN;
- VAR next: BOOLEAN;
- BEGIN
- IF ~Term (value) THEN RETURN FALSE END;
- WHILE symbol.token = Scanner.Or DO
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF ~Term (next) THEN RETURN FALSE END;
- IF next THEN value := TRUE END;
- END;
- RETURN TRUE;
- END Condition;
- BEGIN
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF symbol.token = Scanner.If THEN
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF ~Condition (value) THEN RETURN FALSE END;
- IF symbol.token # Scanner.Then THEN Error (symbol.position, Scanner.Then, ""); RETURN FALSE END;
- conditionals[conditionalCount] := conditional; INC (conditionalCount);
- IF (conditional # Processing) & (conditional # ProcessingElse) THEN conditional := Ignoring;
- ELSIF value THEN conditional := Processing ELSE conditional := Skipping;
- END;
- ELSIF symbol.token = Scanner.Elsif THEN
- IF ~scanner.GetNextSymbol (symbol) THEN RETURN FALSE END;
- IF ~Condition (value) THEN RETURN FALSE END;
- IF symbol.token # Scanner.Then THEN Error (symbol.position, Scanner.Then, ""); RETURN FALSE END;
- IF (conditional = Processing) & (conditionalCount # 0) OR (conditional = Ignoring) THEN conditional := Ignoring;
- ELSIF conditional = Skipping THEN IF value THEN conditional := Processing ELSE conditional := Skipping END;
- ELSE Error(symbol.position,Basic.InvalidCode,"invalid conditional elsif"); RETURN FALSE END;
- ELSIF symbol.token = Scanner.Else THEN
- IF (conditional = Processing) & (conditionalCount # 0) OR (conditional = Ignoring) THEN conditional := IgnoringElse;
- ELSIF conditional = Skipping THEN conditional := ProcessingElse;
- ELSE Error(symbol.position,Basic.InvalidCode,"invalid conditional else"); RETURN FALSE END;
- ELSIF symbol.token = Scanner.End THEN
- IF conditionalCount # 0 THEN DEC (conditionalCount); conditional := conditionals[conditionalCount];
- ELSE Error(symbol.position,Basic.InvalidCode,"invalid conditional end"); RETURN FALSE END;
- ELSE
- Error(symbol.position,Basic.InvalidCode,"invalid conditional statement"); RETURN FALSE;
- END;
- RETURN TRUE;
- END ConditionalStatement;
- (** 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 := ~GetNextSymbol(symbol);*)
- END;
- END SkipComments;
- (** Get next symbol from scanner and store it in object-local variable 'symbol' *)
- PROCEDURE NextSymbol*;
- BEGIN
- (*
- error := ~GetNextSymbol(symbol) OR error;
- hasSymbol := TRUE;
- SkipComments();
- *)
- hasSymbol := FALSE;
- END NextSymbol;
- PROCEDURE Token*(): LONGINT;
- BEGIN
- IF ~hasSymbol OR (symbol.token = Scanner.Escape) THEN
- prevPosition := symbol.position;
- error := ~GetNextSymbol(symbol) OR error;
- IF symbol.token = Scanner.Escape THEN
- error := ~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
- prevPosition := symbol.position;
- error := ~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;
- 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;
- 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
- position := symbol.position;
- 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, Basic.InvalidCode, "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] | Expression { ',' Expression } [',' '?' [',' 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));
- IF Optional(Scanner.Comma) THEN
- ExpressionList(expressionList);
- END;
- 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);
- (* ADDRESS AND SIZE can be type identifiers used for type conversion *)
- ELSIF (Token() = Scanner.Address) OR (Token()=Scanner.Size) 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;
- designator.End(symbol.position);
- 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;
- designator.End(symbol.position);
- END;
- IF OptionalB(Scanner.LeftBrace) THEN
- designator.SetModifiers(Flags());
- END;
- designator.End(symbol.position);
-
- (*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);
- 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;
- array.End(symbol.position);
- RETURN array
- END MathArray;
- (** Factor = Number | Character | String | 'nil' | 'imag' | 'true' | 'false' | Set
- | '(' Expression ')' | '~' Factor | Factor '`' | Designator | MathArray.
- | 'SIZE' 'OF' Designator | 'ADDRESS' 'OF' Designator | 'ALIAS' OF Expression
- **)
- 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);
- 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);
- | Scanner.Not:
- NextSymbol;
- factor := Factor();
- factor := SyntaxTree.NewUnaryExpression( position, factor, Scanner.Not );
- factor.End( symbol.position);
- | Scanner.Address, Scanner.Size:
- operator := Token();
- factor := Designator(); (* ADDRESS AND SIZE can be type identifiers used for type conversion *)
- IF Optional(Scanner.Of) THEN
- factor := Designator();
- factor := SyntaxTree.NewUnaryExpression( position, factor, operator );
- END;
- factor.End (symbol.position)
- | Scanner.Alias:
- operator := Token();
- NextSymbol();
- IF Mandatory(Scanner.Of) THEN
- factor := Factor();
- factor := SyntaxTree.NewUnaryExpression( position, factor, operator );
- END;
- factor.End (symbol.position)
- | Scanner.Self, Scanner.Result, Scanner.Identifier, Scanner.New:
- factor := Designator();
- factor.End( symbol.position);
- | Scanner.LeftBracket:
- NextSymbol;
- factor := MathArray();
- factor.End(symbol.position);
- 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);
- 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;
- expression := RangeExpression();
- position := expression.position;
- IF (TokenB() >= Scanner.Equal) & (TokenB() <= Scanner.Is) THEN
- operator := Token();
- NextSymbol;
- rightExpression := RangeExpression();
- expression := SyntaxTree.NewBinaryExpression(position, expression, rightExpression, operator );
- expression.End(symbol.position);
- 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();
- casePart.SetPosition(symbol.position);
- 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 );
- casePart.SetEnd(symbol.position);
- 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;
- statement.End(prevPosition);
- 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 );
- ifStatement.ifPart.SetEnd(symbol.position);
- WHILE Optional( Scanner.Elsif ) DO
- elsifPart := SyntaxTree.NewIfPart();
- elsifPart.SetPosition(symbol.position);
- CommentIfPart(elsifPart);
- ifStatement.AddElsifPart( elsifPart);
- expression := Expression();
- elsifPart.SetCondition( expression );
- Check( Scanner.Then );
- statementSequence := StatementSequence(ifStatement);
- elsifPart.SetStatements( statementSequence );
- elsifPart.SetEnd(symbol.position);
- END;
- IF Optional( Scanner.Else ) THEN
- statementSequence := StatementSequence(ifStatement);
- ifStatement.SetElsePart( statementSequence );
- END;
- ifStatement.End(symbol.position);
- Check( Scanner.End ); statements.AddStatement( ifStatement );
- result := TRUE
- | Scanner.With:
- withStatement := SyntaxTree.NewWithStatement( symbol.position ,outer);
- CommentStatement(withStatement);
- NextSymbol;
- identifier := Identifier(position);
- IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
- Error(position,Basic.InvalidCode,"forbidden qualified identifier in with statement");
- END;
- designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
- withStatement.SetVariable(designator);
- Check( Scanner.Colon );
- IF Optional(Scanner.Bar) THEN (* ignore *) END;
- REPEAT
- withPart := SyntaxTree.NewWithPart();
- withPart.SetPosition(symbol.position);
- CommentWithPart(withPart);
- withStatement.AddWithPart(withPart);
- qualifiedIdentifier := QualifiedIdentifier();
- IF Optional(Scanner.Colon) THEN (* compatibility with old format *)
- Basic.Warning(diagnostics, scanner.source^, position, "deprecate form of with statement, remove the repeated variable");
- qualifiedIdentifier := QualifiedIdentifier();
- END;
- qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, currentScope, qualifiedIdentifier);
- withPart.SetType(qualifiedType);
- Check( Scanner.Do );
- statementSequence := StatementSequence(withStatement);
- withPart.SetStatements( statementSequence );
- withPart.SetEnd(symbol.position);
- UNTIL ~Optional(Scanner.Bar) OR ~CascadedWithSupport;
- IF CascadedWithSupport & Optional(Scanner.Else) THEN
- statementSequence := StatementSequence(withStatement);
- withStatement.SetElsePart(statementSequence);
- END;
- Check( Scanner.End );
- withStatement.End(symbol.position);
- 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 );
- caseStatement.End(symbol.position);
- 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 );
- whileStatement.End(symbol.position);
- 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.End(prevPosition);
- 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,Basic.InvalidCode,"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 );
- forStatement.End(symbol.position);
- 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 );
- loopStatement.End(symbol.position);
- 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;
- returnStatement.End(symbol.position);
- statements.AddStatement( returnStatement );
- result := TRUE;
- | Scanner.Begin:
- NextSymbol; statement := StatementBlock(outer); statements.AddStatement( statement ); Check( Scanner.End );
- statement.End(symbol.position);
- result := TRUE;
- | Scanner.Await:
- awaitStatement := SyntaxTree.NewAwaitStatement( symbol.position, outer );
- CommentStatement(awaitStatement);
- NextSymbol;
- expression := Expression();
- awaitStatement.SetCondition( expression );
- statements.AddStatement( awaitStatement );
- awaitStatement.End(symbol.position);
- result := TRUE
- | Scanner.Code:
- (* assemble *)
- code := Code(outer);
- Check(Scanner.End);
- code.End(symbol.position);
- 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; statements, rules: SyntaxTree.StatementSequence;
- BEGIN
- startPos := symbol.position;
- end := scanner.SkipToEndOfCode(startPos.start, endPos, symbol);
- codeString := symbol.string;
- WHILE (end = Scanner.Unequal) & ConditionalStatement (symbol) DO
- end := scanner.SkipToEndOfCode(startPos.start, endPos, symbol);
- IF (conditional = Processing) OR (conditional = ProcessingElse) THEN
- codeString := Strings.ConcatToNew (codeString^, symbol.string^);
- END;
- END;
- IF (end = Scanner.End) OR (end = Scanner.With) THEN
- 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;
- body.End(symbol.position); (* beginning of "end" is end of body *)
- 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 ')'] 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;
- 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
- qualifiedIdentifier := QualifiedIdentifier();
- baseType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier);
- 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,Basic.InvalidCode,"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] [';'] {ImportList} 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;
-
- WHILE Optional(Scanner.Import) DO 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;
- LOOP
- IF Optional(Scanner.Procedure) THEN ProcedureDeclaration(recordScope); Ignore(Scanner.Semicolon);
- ELSIF Optional(Scanner.Operator) THEN OperatorDeclaration(recordScope); Ignore(Scanner.Semicolon);
- ELSE EXIT
- END;
- 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;
- modifiers: SyntaxTree.Modifier;
- 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.SetModifiers(modifiers);
- modifiers := NIL;
- mathType.SetArrayBase(base);
- RETURN mathType;
- END MathArray;
- BEGIN
- IF Trace THEN S( "ArrayType" ) END;
- (* array symbol already consumed *)
-
- IF Optional(Scanner.LeftBrace) THEN
- modifiers := Flags();
- END;
- 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 modifiers # NIL THEN
- Error(modifiers.position, Basic.InvalidCode, "forbidden modifiers");
- 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,Basic.InvalidCode,"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, Basic.InvalidCode, "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; 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,Basic.InvalidCode,"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 );
- | 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;
- WHILE Optional(Scanner.Import) DO 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 conditionalCount # 0 THEN Error (symbol.position, Basic.InvalidCode, "missing conditional end"); error := TRUE 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; CONST definitions: ARRAY OF CHAR): Parser;
- VAR parser: Parser;
- BEGIN
- NEW( parser, scanner, diagnostics, definitions ); RETURN parser;
- END NewParser;
- END FoxParser.
- System.FreeDownTo FoxParser ~
|