FoxParser.Mod 80 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159
  1. MODULE FoxParser; (** AUTHOR "fof & fn"; PURPOSE "Oberon Compiler: Parser"; **)
  2. (* (c) fof ETH Zurich, 2009 *)
  3. IMPORT Basic := FoxBasic, Scanner := FoxScanner, D := Debugging, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Diagnostics;
  4. CONST
  5. Trace = FALSE;
  6. CascadedWithSupport = TRUE;
  7. Lax=FALSE;
  8. (** the parser reflects the following EBNF:
  9. Module = ('module' | 'cellnet' [Flags]) Identifier ['in' Identifier]';'
  10. [ImportList] DeclarationSequence [Body]
  11. 'end' Identifier '.'.
  12. ImportList = 'import' Import { ',' Import } ';'.
  13. Import = Identifier [':=' Identifier] ['in' Identifier].
  14. DeclarationSequence = {
  15. 'const' [ConstDeclaration] {';' [ConstDeclaration]}
  16. |'type' [TypeDeclaration] {';' [TypeDeclaration]}
  17. |'var' [VariableDeclaration] {';' [VariableDeclaration]}
  18. | ProcedureDeclaration
  19. | OperatorDeclaration
  20. | ';'
  21. }
  22. Declaration = IdentifierDefinition '=' Expression.
  23. TypeDeclaration = IdentifierDefinition '=' Type.
  24. VariableDeclaration = VariableNameList ':' Type.
  25. VariableNameList = IdentifierDefinition [Flags] [':=' Expression | 'extern' String] {',' IdentifierDefinition [Flags] [':=' Expression | 'extern' String] }.
  26. OperatorDeclaration = 'operator' [Flags] ['-'] String ['*'|'-'] FormalParameters ';'
  27. DeclarationSequence [Body] 'end' String.
  28. ProcedureDeclaration = 'procedure' ['^'|'&'|'~'|'-'|Flags ['-']] IdentifierDefinition [FormalParameters]';'
  29. DeclarationSequence [Body] 'end' Identifier.
  30. Flags = '{' [Identifier ['(' Expression ')'|'=' Expression] {',' Identifier ['(' Expression ')' | '=' Expression ] } ] '}'.
  31. FormalParameters = '(' [ParameterDeclaration {';' ParameterDeclaration}] ')' [':' [Flags] Type].
  32. ParameterDeclaration = ['var'|'const'] Identifier [Flags] ['= Expression] {',' Identifier [Flags] ['= Expression]}':' Type.
  33. PortList = '(' [PortDeclaration {';' PortDeclaration}] ')'.
  34. PortDeclaration = Identifier [Flags] {',' Identifier [Flags]}':' Type.
  35. Type = ArrayType | RecordType | PointerType | ObjectType | CellType | CellnetType | PortType
  36. | ProcedureType | EnumerationType | QualifiedIdentifier.
  37. PortType = 'port' ('in'|'out') ['(' Expression ')']
  38. EnumerationType = 'enum' ['('QualifiedIdentifier')'] IdentifierDefinition ['=' Expression]
  39. {',' IdentifierDefinition ['=' Expression]} 'end'.
  40. ArrayType = 'array' 'of' Type | 'array' Expression {',' Expression} 'of' Type
  41. | 'array' '[' MathArraySize {',' MathArraySize} ']' ['of' Type].
  42. MathArraySize = Expression | '*' | '?'.
  43. RecordType = 'record' [Flags] ['(' QualifiedIdentifier ')'] [VariableDeclaration {';' VariableDeclaration}] 'end'.
  44. PointerType = 'pointer' [Flags] 'to' Type.
  45. CellType = 'cell' [Flags] [PortList] [';'] DeclarationSequence [Body] 'end' [Identifier].
  46. ObjectType = 'object' | 'object' [Flags] ['(' (QualifiedIdentifier | ArrayType) ')'] DeclarationSequence [Body] 'end' [Identifier] .
  47. ProcedureType = 'procedure' [Flags] [FormalParameters].
  48. Body = 'begin' [Flags] StatementSequence ['finally' StatementSequence]
  49. | 'code' Code.
  50. Code = { any \ 'end' \ 'with' } ['with' {('in'|'out') StatementSequence}] .
  51. StatementBlock = [Flags] StatementSequence.
  52. StatementSequence = Statement {';' Statement}.
  53. Statement =
  54. [
  55. Designator [':=' Expression |'!' Expression | '?' Expression | '<<' Expresssion | '>>' Expression]
  56. | 'if' Expression 'then' StatementSequence
  57. {'elsif' Expression 'then' StatementSequence}
  58. ['else' StatementSequence]
  59. 'end'
  60. | 'with' Identifier ':' QualifiedIdentifier 'do' StatementSequence
  61. {'|' Identifier ':' QualifiedIdentifier 'do' StatementSequence}
  62. [else StatementSequence]
  63. 'end'
  64. | 'case' Expression 'of' ['|'] Case {'|' Case} ['else' StatementSequence] 'end'
  65. | 'while' Expression 'do' StatementSequence 'end'
  66. | 'repeat' StatementSequence 'until' Expression
  67. | 'for' Identifier ':=' Expression 'to' Expression ['by' Expression] 'do'
  68. StatementSequence 'end'
  69. | 'loop' StatementSequence 'end'
  70. | 'exit'
  71. | 'return' [Expression]
  72. | 'await' Expression
  73. | 'begin' StatementBlock 'end'
  74. | 'code' {any} 'end'
  75. ].
  76. Case = RangeExpression {',' RangeExpression} ':' StatementSequence.
  77. Expression = RangeExpression [RelationOp RangeExpression].
  78. RelationOp = '=' | '.=' | '#' | '.#'
  79. | '<' | '.<' | '<=' | '.<=' | '>' | '.>' | '>=' | '.>='
  80. | '??' | '!!' | '<<?' | '>>?'
  81. | 'in' | 'is'
  82. SimpleExpression = ['+'|'-'] Term {AddOp Term}.
  83. AddOp = '+' | '-' | 'or'.
  84. Term = Factor {MulOp Factor}.
  85. MulOp = '*' | '**' | '.*' | '+*' | '/' | '\' | './' | 'div' | 'mod' | '&'.
  86. Factor = Number | Character | String | 'nil' | 'imag' | 'true' | 'false' | Set
  87. | '(' Expression ')' | '~' Factor | Factor '`' | Designator | MathArray.
  88. | 'SIZE' 'OF' Designator | 'ADDRESS' 'OF' Designator
  89. MathArray = '[' Expression {',' Expression} ']'.
  90. Set = '{' [ RangeExpression {',' RangeExpression} ] '}'.
  91. Designator = ('self' | 'result' | Identifier)
  92. {'.' Identifier | '[' IndexList ']' | '(' [ExpressionList] ')' | '^'} [Flags].
  93. RangeExpression = SimpleExpression | [SimpleExpression] '..' [SimpleExpression] ['by' SimpleExpression] | '*'.
  94. IndexList = '?' [',' ExpressionList ] | ExpressionList [',' '?'].
  95. ExpressionList = Expression { ',' Expression }.
  96. IdentifierDefinition = Identifier [ '*' | '-' ].
  97. QualifiedIdentifier = Identifier ['.' Identifier].
  98. Identifier = Letter {Letter | Digit | '_'}.
  99. Letter = 'A' | 'B' | .. | 'Z' | 'a' | 'b' | .. | 'z'.
  100. String = '"' {Character} '"' | "'" {Character} "'".
  101. Number = Integer | Real.
  102. Integer = Digit {Digit} | Digit {HexDigit} 'H'.
  103. Real = Digit {Digit} '.' {Digit} [ScaleFactor].
  104. ScaleFactor = ('E' | 'D') ['+' | '-'] digit {digit}.
  105. HexDigit = Digit | 'A' | 'B' | 'C' | 'D' | 'E' | 'F'
  106. Digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' .
  107. **)
  108. TYPE
  109. Parser* = OBJECT
  110. VAR scanner-: Scanner.Scanner;
  111. symbol-: Scanner.Symbol;
  112. diagnostics: Diagnostics.Diagnostics;
  113. currentScope: SyntaxTree.Scope;
  114. recentCommentItem: ANY; recentLine: LONGINT;
  115. recentComment: SyntaxTree.Comment;
  116. moduleScope: SyntaxTree.ModuleScope;
  117. error-: BOOLEAN;
  118. activeCellsSupport: BOOLEAN;
  119. indent: LONGINT; (* for debugging purposes only *)
  120. PROCEDURE S( CONST s: ARRAY OF CHAR ); (* for debugging purposes only *)
  121. VAR i: LONGINT;
  122. BEGIN
  123. D.Ln; INC( indent ); D.Int( indent,1 );
  124. FOR i := 1 TO indent DO D.Str( " " ); END;
  125. D.Str( "start: " ); D.Str( s ); D.Str( " at pos " ); D.Int( symbol.start,1 );
  126. END S;
  127. PROCEDURE E( CONST s: ARRAY OF CHAR ); (* for debugging purposes only *)
  128. VAR i: LONGINT;
  129. BEGIN
  130. D.Ln; D.Int( indent,1 );
  131. FOR i := 1 TO indent DO D.Str( " " ); END;
  132. D.Str( "end : " ); D.Str( s ); D.Str( " at pos " ); D.Int( symbol.start,1 );
  133. END E;
  134. PROCEDURE EE( CONST s, t: ARRAY OF CHAR ); (* for debugging purposes only *)
  135. VAR i: LONGINT;
  136. BEGIN
  137. D.Ln; D.Int( indent,1 );
  138. FOR i := 1 TO indent DO D.Str( " " ); END;
  139. D.Str( "end : " ); D.Str( s ); D.Str( " (" ); D.Str( t ); D.Str( ") at pos " );
  140. END EE;
  141. (** constructor, init parser with scanner providing input and with diagnostics for error output *)
  142. PROCEDURE & Init*( scanner: Scanner.Scanner; diagnostics: Diagnostics.Diagnostics );
  143. BEGIN
  144. SELF.scanner := scanner;
  145. SELF.diagnostics := diagnostics;
  146. error := ~scanner.GetNextSymbol(symbol);
  147. recentCommentItem := NIL; recentComment := NIL;
  148. (* debugging *)
  149. indent := 0;
  150. activeCellsSupport := FALSE;
  151. END Init;
  152. PROCEDURE ActiveCellsSupport*;
  153. BEGIN activeCellsSupport := TRUE
  154. END ActiveCellsSupport;
  155. (** output error message and / or given code *)
  156. PROCEDURE Error(position: LONGINT; code: LONGINT; CONST message: ARRAY OF CHAR);
  157. VAR errorMessage: ARRAY 256 OF CHAR;
  158. BEGIN
  159. IF diagnostics # NIL THEN
  160. Basic.GetErrorMessage(code,message,errorMessage);
  161. diagnostics.Error(scanner.source^, position, code, errorMessage);
  162. END;
  163. error := TRUE
  164. END Error;
  165. (** helper procedures interfacing to the scanner **)
  166. PROCEDURE SkipComments();
  167. VAR comment: SyntaxTree.Comment;
  168. BEGIN
  169. WHILE ~error & (symbol.token = Scanner.Comment) DO
  170. comment := SyntaxTree.NewComment(symbol.start, currentScope, symbol.string^,symbol.stringLength);
  171. IF moduleScope # NIL THEN
  172. moduleScope.AddComment(comment);
  173. END;
  174. IF recentComment = NIL THEN
  175. recentComment := comment;
  176. IF symbol.line = recentLine THEN
  177. IF recentCommentItem # NIL THEN
  178. IF (recentCommentItem IS SyntaxTree.Symbol) THEN
  179. IF recentCommentItem(SyntaxTree.Symbol).comment = NIL THEN
  180. recentCommentItem(SyntaxTree.Symbol).SetComment(comment)
  181. END;
  182. ELSIF (recentCommentItem IS SyntaxTree.Statement) THEN
  183. IF recentCommentItem(SyntaxTree.Statement).comment = NIL THEN
  184. recentCommentItem(SyntaxTree.Statement).SetComment(comment)
  185. END;
  186. ELSIF (recentCommentItem IS SyntaxTree.IfPart) THEN
  187. IF recentCommentItem(SyntaxTree.IfPart).comment = NIL THEN
  188. recentCommentItem(SyntaxTree.IfPart).SetComment(comment)
  189. END;
  190. ELSIF (recentCommentItem IS SyntaxTree.CasePart) THEN
  191. IF recentCommentItem(SyntaxTree.CasePart).comment = NIL THEN
  192. recentCommentItem(SyntaxTree.CasePart).SetComment(comment)
  193. END;
  194. ELSIF (recentCommentItem IS SyntaxTree.WithPart) THEN
  195. IF recentCommentItem(SyntaxTree.WithPart).comment = NIL THEN
  196. recentCommentItem(SyntaxTree.WithPart).SetComment(comment)
  197. END;
  198. END;
  199. comment.SetItem(recentCommentItem,TRUE);
  200. recentComment := NIL;
  201. recentCommentItem := NIL
  202. END;
  203. END;
  204. END;
  205. error := ~scanner.GetNextSymbol(symbol);
  206. END;
  207. END SkipComments;
  208. (** Get next symbol from scanner and store it in object-local variable 'symbol' *)
  209. PROCEDURE NextSymbol*;
  210. VAR comment: SyntaxTree.Comment;
  211. BEGIN
  212. error := ~scanner.GetNextSymbol(symbol) OR error;
  213. SkipComments();
  214. END NextSymbol;
  215. (** Check if current symbol equals sym. If yes then return true, return false otherwise *)
  216. PROCEDURE Peek*(token: Scanner.Token): BOOLEAN;
  217. VAR comment: SyntaxTree.Comment;
  218. BEGIN
  219. SkipComments();
  220. RETURN symbol.token = token
  221. END Peek;
  222. (** Check if the current symbol equals sym.If yes then read next symbol, report error otherwise. returns success value *)
  223. PROCEDURE Mandatory*( token: Scanner.Token): BOOLEAN;
  224. BEGIN
  225. ASSERT( token # Scanner.Identifier ); ASSERT( token # Scanner.String ); ASSERT( token # Scanner.Number ); (* because of NextSymbol ! *)
  226. IF ~Peek(token) THEN
  227. Error( symbol.start, token, "" );
  228. RETURN FALSE
  229. ELSE
  230. NextSymbol;
  231. RETURN TRUE
  232. END
  233. END Mandatory;
  234. (** Check if the current symbol equals sym. If yes then read next symbol, report error otherwise *)
  235. PROCEDURE Check( token: Scanner.Token );
  236. VAR b: BOOLEAN;
  237. BEGIN
  238. b := Mandatory( token );
  239. END Check;
  240. (** Check if current symbol is an identifier. If yes then copy identifier to name and get next symbol,
  241. report error otherwise and set name to empty name. returns success value *)
  242. PROCEDURE MandatoryIdentifier( VAR name: SyntaxTree.Identifier): BOOLEAN;
  243. BEGIN
  244. IF Peek(Scanner.Identifier) THEN
  245. name := symbol.identifier;
  246. NextSymbol;
  247. RETURN TRUE
  248. ELSE
  249. Error( symbol.start, Scanner.Identifier, "" );
  250. name := SyntaxTree.invalidIdentifier;
  251. RETURN FALSE
  252. END
  253. END MandatoryIdentifier;
  254. (** Expect an identifier (using MandatoryIdentifier) and return identifier object **)
  255. PROCEDURE Identifier(VAR position: LONGINT): SyntaxTree.Identifier;
  256. VAR name: SyntaxTree.Identifier; identifier: SyntaxTree.Identifier;
  257. BEGIN
  258. position := symbol.start;
  259. IF MandatoryIdentifier(name) THEN
  260. identifier := name;
  261. ELSE
  262. identifier := SyntaxTree.invalidIdentifier;
  263. END;
  264. RETURN identifier
  265. END Identifier;
  266. (** Check if current symbol is a string (or string-like character). If yes then copy identifier to name and get next symbol,
  267. report error otherwise and set name to empty name. returns success value*)
  268. PROCEDURE MandatoryString*( VAR name: Scanner.StringType ): BOOLEAN;
  269. BEGIN
  270. IF Peek( Scanner.String) THEN
  271. name := symbol.string;
  272. NextSymbol;
  273. RETURN TRUE
  274. ELSIF Peek( Scanner.Character) THEN (* for compatibility with release: characters treated as strings *)
  275. name := symbol.string;
  276. NextSymbol;
  277. RETURN TRUE
  278. ELSE
  279. Error( symbol.start, Scanner.String, "" );
  280. NEW(name,1); name^ := "";
  281. RETURN FALSE
  282. END
  283. END MandatoryString;
  284. (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
  285. PROCEDURE ExpectThisIdentifier( name: SyntaxTree.Identifier ): BOOLEAN;
  286. VAR string: ARRAY 64 OF CHAR;
  287. BEGIN
  288. IF name = SyntaxTree.invalidIdentifier THEN (* nothing to be expected *)
  289. RETURN TRUE
  290. ELSIF (symbol.token # Scanner.Identifier) OR (symbol.identifier # name) THEN
  291. Basic.GetString(name,string);
  292. Error( symbol.start, Scanner.Identifier, string );
  293. RETURN FALSE
  294. ELSE
  295. NextSymbol;
  296. RETURN TRUE
  297. END
  298. END ExpectThisIdentifier;
  299. (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
  300. PROCEDURE ExpectThisString( CONST name: ARRAY OF CHAR ): BOOLEAN;
  301. BEGIN
  302. IF Peek(Scanner.String) & (symbol.string^ = name) THEN
  303. NextSymbol;
  304. RETURN TRUE
  305. ELSE
  306. Error( symbol.start, Scanner.String, name );
  307. RETURN FALSE
  308. END
  309. END ExpectThisString;
  310. (** Check if current symbol equals sym. If yes then get next symbol, return false otherwise *)
  311. PROCEDURE Optional*( token: Scanner.Token ): BOOLEAN;
  312. BEGIN
  313. (* do not use for Identifier, String or Number, if the result is needed ! *)
  314. IF Peek(token) THEN
  315. NextSymbol;
  316. RETURN TRUE
  317. ELSE
  318. RETURN FALSE
  319. END
  320. END Optional;
  321. (* ignore one ore more symbols of type token *)
  322. PROCEDURE Ignore(token: Scanner.Token);
  323. BEGIN WHILE Optional(token) DO END;
  324. END Ignore;
  325. (** Parsing according to the EBNF **)
  326. (** QualifiedIdentifier = Identifier ['.' Identifier]. **)
  327. PROCEDURE QualifiedIdentifier*( ): SyntaxTree.QualifiedIdentifier;
  328. VAR prefix,suffix: SyntaxTree.Identifier; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; position0,position1: LONGINT;
  329. BEGIN
  330. IF Trace THEN S( "QualifiedIdentifier" ) END;
  331. prefix := Identifier(position0);
  332. IF prefix # SyntaxTree.invalidIdentifier THEN
  333. IF ~Optional( Scanner.Period )THEN
  334. suffix := prefix; prefix := SyntaxTree.invalidIdentifier; (* empty *)
  335. ELSE
  336. suffix := Identifier(position1);
  337. END;
  338. qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier( position0, prefix,suffix);
  339. ELSE
  340. qualifiedIdentifier := SyntaxTree.invalidQualifiedIdentifier;
  341. END;
  342. IF Trace THEN E( "QualifiedIdentifier" ) END;
  343. RETURN qualifiedIdentifier
  344. END QualifiedIdentifier;
  345. (** IdentifierDefinition = Identifier [ '*' | '-' ]. **)
  346. PROCEDURE IdentifierDefinition( VAR name: SyntaxTree.Identifier; VAR access: SET; allowedReadOnly: BOOLEAN);
  347. VAR position: LONGINT;
  348. BEGIN
  349. IF Trace THEN S( "IdentifierDefinition" ) END;
  350. name := Identifier(position);
  351. IF Optional( Scanner.Times ) THEN
  352. access := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal;
  353. ELSIF Optional( Scanner.Minus ) THEN
  354. IF ~allowedReadOnly THEN
  355. Error( symbol.start, Diagnostics.Invalid, "may not be defined read-only" )
  356. ELSE
  357. access := SyntaxTree.ReadOnly + {SyntaxTree.InternalWrite};
  358. END;
  359. ELSE
  360. access := SyntaxTree.Internal;
  361. END;
  362. IF Trace THEN E( "IdentifierDefinition") END;
  363. END IdentifierDefinition;
  364. (** ExpressionList = Expression { ',' Expression }. **)
  365. PROCEDURE ExpressionList( expressionList: SyntaxTree.ExpressionList );
  366. VAR expression: SyntaxTree.Expression;
  367. BEGIN
  368. IF Trace THEN S( "ExpressionList" ) END;
  369. REPEAT
  370. expression := Expression();
  371. expressionList.AddExpression( expression )
  372. UNTIL ~Optional( Scanner.Comma );
  373. IF Trace THEN E( "ExpressionList" ) END;
  374. END ExpressionList;
  375. (** IndexList = '?' [',' ExpressionList ] | ExpressionList [',' '?']. **)
  376. PROCEDURE IndexList(expressionList: SyntaxTree.ExpressionList);
  377. VAR
  378. position: LONGINT;
  379. done: BOOLEAN;
  380. BEGIN
  381. IF Trace THEN S( "IndexList" ) END;
  382. position := symbol.start;
  383. IF Optional(Scanner.Questionmark) THEN
  384. expressionList.AddExpression(SyntaxTree.NewTensorRangeExpression(position));
  385. IF Optional(Scanner.Comma) THEN
  386. ExpressionList(expressionList);
  387. END
  388. ELSE
  389. expressionList.AddExpression(Expression());
  390. done := FALSE;
  391. WHILE ~done DO
  392. IF Optional(Scanner.Comma) THEN
  393. IF Optional(Scanner.Questionmark) THEN
  394. expressionList.AddExpression(SyntaxTree.NewTensorRangeExpression(position));
  395. done := TRUE;
  396. ELSE
  397. expressionList.AddExpression(Expression())
  398. END
  399. ELSE
  400. done := TRUE
  401. END
  402. END
  403. END;
  404. IF Trace THEN E( "IndexList" ) END;
  405. END IndexList;
  406. (** RangeExpression = SimpleExpression | [SimpleExpression] '..' [SimpleExpression] ['by' SimpleExpression] | '*'.
  407. i.e., a RangeExpression can have one of the following forms:
  408. '*'
  409. '..' [delimiter]
  410. '..' 'by' SimpleExpression
  411. '..' SimpleExpression
  412. '..' SimpleExpression 'by' SimpleExpression
  413. SimpleExpression
  414. SimpleExpression '..' [delimiter]
  415. SimpleExpression '..' 'by' SimpleExpression
  416. SimpleExpression '..' SimpleExpression
  417. SimpleExpression '..' SimpleExpression 'by' SimpleExpression
  418. a RangeExpression is always delimited by any of the following tokens: ",", ";", ":", "]", ")", "}", "=", "#", "END".
  419. **)
  420. PROCEDURE RangeExpression(): SyntaxTree.Expression;
  421. VAR
  422. expression, first, last, step: SyntaxTree.Expression;
  423. position: LONGINT;
  424. PROCEDURE HasDelimiter(): BOOLEAN;
  425. BEGIN RETURN
  426. Peek(Scanner.Comma) OR Peek(Scanner.Semicolon) OR Peek(Scanner.Colon) OR
  427. Peek(Scanner.RightBracket) OR Peek(Scanner.RightParenthesis) OR Peek(Scanner.RightBrace) OR
  428. Peek(Scanner.Equal) OR Peek(Scanner.Unequal) OR Peek(Scanner.End)
  429. END HasDelimiter;
  430. BEGIN
  431. IF Trace THEN S( "RangeExpression" ) END;
  432. position := symbol.start;
  433. IF Optional(Scanner.Times) THEN
  434. expression := SyntaxTree.NewRangeExpression(position, NIL, NIL, NIL)
  435. ELSIF Optional(Scanner.Upto) THEN
  436. (* is range expression *)
  437. first := NIL;
  438. IF HasDelimiter() THEN
  439. last := NIL;
  440. step := NIL
  441. ELSIF Optional(Scanner.By) THEN
  442. last := NIL;
  443. step := SimpleExpression()
  444. ELSE
  445. last := SimpleExpression();
  446. IF Optional(Scanner.By) THEN
  447. step := SimpleExpression()
  448. ELSE
  449. step := NIL
  450. END
  451. END;
  452. expression := SyntaxTree.NewRangeExpression(position, first, last, step)
  453. ELSE
  454. expression := SimpleExpression();
  455. IF Optional(Scanner.Upto) THEN
  456. (* is range expression *)
  457. first := expression;
  458. IF HasDelimiter() THEN
  459. last := NIL;
  460. step := NIL
  461. ELSIF Optional(Scanner.By) THEN
  462. last := NIL;
  463. step := SimpleExpression()
  464. ELSE
  465. last := SimpleExpression();
  466. IF Optional(Scanner.By) THEN
  467. step := SimpleExpression()
  468. ELSE
  469. step := NIL
  470. END
  471. END;
  472. expression := SyntaxTree.NewRangeExpression(position, first, last, step)
  473. END;
  474. END;
  475. IF Trace THEN E( "RangeExpression" ) END;
  476. RETURN expression
  477. END RangeExpression;
  478. (** Designator = ('self' | 'result' | Identifier)
  479. {'.' Identifier | '[' IndexList ']' | '(' [ExpressionList] ')' | '^'} [Flags].
  480. **)
  481. PROCEDURE Designator( ): SyntaxTree.Designator;
  482. VAR
  483. designator: SyntaxTree.Designator; expressionList: SyntaxTree.ExpressionList;
  484. identifier: SyntaxTree.Identifier; position: LONGINT;
  485. BEGIN
  486. IF Trace THEN S( "Designator" ) END;
  487. position := symbol.start;
  488. IF Optional(Scanner.Self) THEN
  489. designator := SyntaxTree.NewSelfDesignator(position);
  490. ELSIF Optional(Scanner.Result) THEN
  491. designator := SyntaxTree.NewResultDesignator(position);
  492. ELSIF (symbol.token = Scanner.Address) OR (symbol.token = Scanner.Size) OR (symbol.token = Scanner.Alias) THEN
  493. identifier := symbol.identifier;
  494. designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
  495. NextSymbol;
  496. ELSE
  497. identifier := Identifier(position);
  498. designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
  499. END;
  500. LOOP
  501. position := symbol.start;
  502. IF Optional( Scanner.LeftParenthesis ) THEN
  503. expressionList := SyntaxTree.NewExpressionList();
  504. IF ~Optional( Scanner.RightParenthesis ) THEN
  505. ExpressionList( expressionList );
  506. Check( Scanner.RightParenthesis )
  507. END;
  508. designator := SyntaxTree.NewParameterDesignator( position,designator,expressionList);
  509. ELSIF Optional( Scanner.Period ) THEN
  510. CASE symbol.identifierString[0] OF
  511. "a".."z", "A" .. "Z":
  512. (*IF Peek(Scanner.Size) (* special rule: support for SYSTEM.SIZE *) THEN*)
  513. identifier := symbol.identifier; NextSymbol;
  514. ELSE
  515. identifier := Identifier(position);
  516. END;
  517. designator := SyntaxTree.NewSelectorDesignator(position,designator,identifier);
  518. ELSIF Optional( Scanner.LeftBracket ) THEN
  519. expressionList := SyntaxTree.NewExpressionList();
  520. IndexList( expressionList );
  521. Check( Scanner.RightBracket );
  522. designator:= SyntaxTree.NewBracketDesignator( position,designator,expressionList );
  523. ELSIF Optional( Scanner.Arrow ) THEN
  524. designator:= SyntaxTree.NewArrowDesignator( position,designator );
  525. ELSE EXIT
  526. END;
  527. END;
  528. IF Optional(Scanner.LeftBrace) THEN
  529. designator.SetModifiers(Flags());
  530. END;
  531. IF Trace THEN E( "Designator" ) END;
  532. RETURN designator
  533. END Designator;
  534. (** Set = '{' [ RangeExpression {',' RangeExpression} ] '}'. **)
  535. PROCEDURE Set( ): SyntaxTree.Expression;
  536. VAR
  537. set: SyntaxTree.Set;
  538. BEGIN
  539. IF Trace THEN S( "Set" ) END;
  540. set := SyntaxTree.NewSet(symbol.start);
  541. Check(Scanner.LeftBrace);
  542. IF ~Optional(Scanner.RightBrace) THEN
  543. REPEAT
  544. set.elements.AddExpression(RangeExpression())
  545. UNTIL ~Optional(Scanner.Comma);
  546. Check(Scanner.RightBrace);
  547. END;
  548. set.End(symbol.start);
  549. IF Trace THEN E( "Set" ) END;
  550. RETURN set
  551. END Set;
  552. (* MathArray = '[' Expression {',' Expression} ']'. *)
  553. PROCEDURE MathArray(): SyntaxTree.Expression;
  554. VAR array: SyntaxTree.MathArrayExpression; element: SyntaxTree.Expression;
  555. BEGIN
  556. array := SyntaxTree.NewMathArrayExpression(symbol.start);
  557. IF ~Optional(Scanner.RightBracket) THEN
  558. REPEAT
  559. element := Expression();
  560. array.elements.AddExpression(element);
  561. UNTIL ~Optional(Scanner.Comma);
  562. Check(Scanner.RightBracket);
  563. END;
  564. RETURN array
  565. END MathArray;
  566. (** Factor = Number | Character | String | 'nil' | 'imag' | 'true' | 'false' | Set
  567. | '(' Expression ')' | '~' Factor | Factor '`' | Designator | MathArray.
  568. | 'SIZE' 'OF' Designator | 'ADDRESS' 'OF' Designator
  569. **)
  570. PROCEDURE Factor( ): SyntaxTree.Expression;
  571. VAR factor: SyntaxTree.Expression; position,operator: LONGINT;
  572. BEGIN
  573. IF Trace THEN S( "Factor" ) END;
  574. position := symbol.start;
  575. CASE symbol.token OF
  576. | Scanner.Number:
  577. IF (symbol.numberType = Scanner.Integer) THEN
  578. factor := SyntaxTree.NewIntegerValue( position, symbol.integer);
  579. factor.End( symbol.end );
  580. ELSIF (symbol.numberType = Scanner.Hugeint) THEN
  581. factor := SyntaxTree.NewIntegerValue(position, symbol.hugeint);
  582. factor.End( symbol.end );
  583. ELSIF (symbol.numberType = Scanner.Real) OR (symbol.numberType = Scanner.Longreal) THEN
  584. factor := SyntaxTree.NewRealValue( position, symbol.real);
  585. factor(SyntaxTree.RealValue).SetSubtype(symbol.numberType);
  586. factor.End( symbol.end );
  587. ELSE HALT( 100 )
  588. END;
  589. NextSymbol;
  590. | Scanner.Character:
  591. factor := SyntaxTree.NewCharacterValue(position,symbol.character);
  592. factor.End(symbol.end);
  593. NextSymbol;
  594. | Scanner.String:
  595. factor := SyntaxTree.NewStringValue( position, symbol.string );
  596. factor.End( symbol.end );
  597. NextSymbol;
  598. WHILE (symbol.token = Scanner.String) OR (symbol.token = Scanner.Character) DO
  599. IF symbol.token = Scanner.Character THEN
  600. factor(SyntaxTree.StringValue).AppendChar(symbol.character);
  601. ELSE
  602. factor(SyntaxTree.StringValue).Append(symbol.string);
  603. END;
  604. factor.End(symbol.end);
  605. NextSymbol;
  606. END;
  607. | Scanner.Nil:
  608. factor := SyntaxTree.NewNilValue( position );
  609. factor.End( symbol.end );
  610. NextSymbol;
  611. | Scanner.Imag:
  612. factor := SyntaxTree.NewComplexValue(position, 0, 1);
  613. factor(SyntaxTree.ComplexValue).SetSubtype(Scanner.Real);
  614. factor.End( symbol.end );
  615. NextSymbol;
  616. | Scanner.True:
  617. factor := SyntaxTree.NewBooleanValue( position, TRUE );
  618. factor.End( symbol.end );
  619. NextSymbol;
  620. | Scanner.False:
  621. factor := SyntaxTree.NewBooleanValue( position, FALSE );
  622. factor.End( symbol.end );
  623. NextSymbol;
  624. | Scanner.LeftBrace:
  625. factor := Set();
  626. | Scanner.LeftParenthesis:
  627. NextSymbol;
  628. factor := Expression();
  629. Check( Scanner.RightParenthesis );
  630. factor.End( symbol.end );
  631. | Scanner.Not:
  632. NextSymbol;
  633. factor := Factor();
  634. factor := SyntaxTree.NewUnaryExpression( position, factor, Scanner.Not );
  635. factor.End( symbol.end );
  636. | Scanner.Address, Scanner.Size, Scanner.Alias:
  637. operator := symbol.token;
  638. factor := Designator();
  639. IF Optional(Scanner.Of) THEN
  640. factor := Designator();
  641. factor := SyntaxTree.NewUnaryExpression( position, factor, operator );
  642. END;
  643. factor.End (symbol.end)
  644. | Scanner.Self, Scanner.Result, Scanner.Identifier:
  645. factor := Designator();
  646. factor.End( symbol.end );
  647. | Scanner.LeftBracket:
  648. NextSymbol;
  649. factor := MathArray();
  650. factor.End(symbol.end);
  651. ELSE
  652. Error( position, Basic.ValueStartIncorrectSymbol, "" );
  653. NextSymbol; factor := SyntaxTree.invalidExpression;
  654. END;
  655. (* suffix *)
  656. IF Optional(Scanner.Transpose) THEN
  657. IF (factor IS SyntaxTree.UnaryExpression) & (factor(SyntaxTree.UnaryExpression).operator = Scanner.Transpose) THEN
  658. (* transpose operator has higher precedence than not, reevaluate expression: *)
  659. factor := factor(SyntaxTree.UnaryExpression).left;
  660. factor := SyntaxTree.NewUnaryExpression(position,factor,Scanner.Transpose);
  661. factor := SyntaxTree.NewUnaryExpression(position,factor,Scanner.Not);
  662. ELSE
  663. factor := SyntaxTree.NewUnaryExpression(position,factor,Scanner.Transpose);
  664. END;
  665. END;
  666. IF Trace THEN E( "Factor" ) END;
  667. RETURN factor
  668. END Factor;
  669. (** Term = Factor {MulOp Factor}.
  670. MulOp = '*' | '**' | '.*' | '+*' | '/' | '\' | './' | 'div' | 'mod' | '&'.
  671. **)
  672. PROCEDURE Term( ): SyntaxTree.Expression;
  673. VAR term, factor: SyntaxTree.Expression; operator: LONGINT; position: LONGINT;
  674. BEGIN
  675. IF Trace THEN S( "Term" ) END;
  676. position := symbol.start;
  677. term := Factor();
  678. WHILE (symbol.token >= Scanner.Times) & (symbol.token <= Scanner.And) DO
  679. operator := symbol.token;
  680. NextSymbol;
  681. factor := Factor();
  682. term := SyntaxTree.NewBinaryExpression( position, term, factor, operator );
  683. END;
  684. term.End( symbol.end );
  685. IF Trace THEN E( "Term" ) END;
  686. RETURN term
  687. END Term;
  688. (** SimpleExpression = ['+'|'-'] Term {AddOp Term}.
  689. AddOp = '+' | '-' | 'or'.
  690. **)
  691. PROCEDURE SimpleExpression( ): SyntaxTree.Expression;
  692. VAR operator: LONGINT; term, expression: SyntaxTree.Expression; position: LONGINT;
  693. BEGIN
  694. IF Trace THEN S( "SimpleExpression" ) END;
  695. position := symbol.start;
  696. IF Peek(Scanner.Plus) OR Peek(Scanner.Minus) THEN (* sign should be part of the factor *)
  697. operator := symbol.token;
  698. NextSymbol;
  699. term := Term();
  700. expression := SyntaxTree.NewUnaryExpression( position, term, operator );
  701. ELSE expression := Term();
  702. END;
  703. WHILE (symbol.token >= Scanner.Or) & (symbol.token <= Scanner.Minus) DO
  704. operator := symbol.token;
  705. NextSymbol;
  706. term := Term();
  707. expression := SyntaxTree.NewBinaryExpression( position, expression, term, operator );
  708. END;
  709. IF Trace THEN E( "SimpleExpression" ) END;
  710. RETURN expression
  711. END SimpleExpression;
  712. (**
  713. Expression = RangeExpression [RelationOp RangeExpression].
  714. RelationOp = '=' | '.=' | '#' | '.#'
  715. | '<' | '.<' | '<=' | '.<=' | '>' | '.>' | '>=' | '.>='
  716. | '??' | '!!' | '<<?' | '>>?'
  717. | 'in' | 'is'
  718. **)
  719. PROCEDURE Expression*( ): SyntaxTree.Expression;
  720. VAR expression, rightExpression: SyntaxTree.Expression; operator: LONGINT; position: LONGINT;
  721. BEGIN
  722. IF Trace THEN S( "Expression" ) END;
  723. position := symbol.start;
  724. expression := RangeExpression();
  725. IF (symbol.token >= Scanner.Equal) & (symbol.token <= Scanner.Is) THEN
  726. operator := symbol.token;
  727. NextSymbol;
  728. rightExpression := RangeExpression();
  729. expression := SyntaxTree.NewBinaryExpression(position, expression, rightExpression, operator );
  730. END;
  731. IF Trace THEN E( "Expression" ) END;
  732. RETURN expression
  733. END Expression;
  734. (** Case = RangeExpression {',' RangeExpression} ':' StatementSequence. **)
  735. PROCEDURE Case( caseStatement: SyntaxTree.CaseStatement );
  736. VAR
  737. casePart: SyntaxTree.CasePart;
  738. statements: SyntaxTree.StatementSequence;
  739. element: SyntaxTree.Expression;
  740. BEGIN
  741. IF Trace THEN S( "Case" ) END;
  742. casePart := SyntaxTree.NewCasePart();
  743. CommentCasePart(casePart);
  744. REPEAT
  745. element := RangeExpression();
  746. casePart.elements.AddExpression( element );
  747. UNTIL ~Optional( Scanner.Comma );
  748. Check( Scanner.Colon );
  749. statements := StatementSequence(caseStatement);
  750. casePart.SetStatements( statements );
  751. caseStatement.AddCasePart( casePart );
  752. IF Trace THEN E( "Case" ) END;
  753. END Case;
  754. (** Statement =
  755. [
  756. Designator [':=' Expression |'!' Expression | '?' Expression | '<<' Expresssion | '>>' Expression]
  757. | 'if' Expression 'then' StatementSequence
  758. {'elsif' Expression 'then' StatementSequence}
  759. ['else' StatementSequence]
  760. 'end'
  761. | 'with' Identifier ':' QualifiedIdentifier 'do' StatementSequence
  762. {'|' Identifier ':' QualifiedIdentifier 'do' StatementSequence}
  763. [else StatementSequence]
  764. 'end'
  765. | 'case' Expression 'of' ['|'] Case {'|' Case} ['else' StatementSequence] 'end'
  766. | 'while' Expression 'do' StatementSequence 'end'
  767. | 'repeat' StatementSequence 'until' Expression
  768. | 'for' Identifier ':=' Expression 'to' Expression ['by' Expression] 'do'
  769. StatementSequence 'end'
  770. | 'loop' StatementSequence 'end'
  771. | 'exit'
  772. | 'return' [Expression]
  773. | 'await' Expression
  774. | 'begin' StatementBlock 'end'
  775. | 'code' {any} 'end'
  776. ].
  777. **)
  778. PROCEDURE Statement*( statements: SyntaxTree.StatementSequence; outer: SyntaxTree.Statement): BOOLEAN;
  779. VAR qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; expression: SyntaxTree.Expression; designator: SyntaxTree.Designator; statement: SyntaxTree.Statement;
  780. ifStatement: SyntaxTree.IfStatement; elsifPart: SyntaxTree.IfPart; statementSequence: SyntaxTree.StatementSequence; withStatement: SyntaxTree.WithStatement;
  781. withPart: SyntaxTree.WithPart; caller: SyntaxTree.ProcedureCallStatement;
  782. caseStatement: SyntaxTree.CaseStatement; whileStatement: SyntaxTree.WhileStatement; repeatStatement: SyntaxTree.RepeatStatement; forStatement: SyntaxTree.ForStatement;
  783. identifier: SyntaxTree.Identifier; loopStatement: SyntaxTree.LoopStatement; returnStatement: SyntaxTree.ReturnStatement; awaitStatement: SyntaxTree.AwaitStatement;
  784. qualifiedType: SyntaxTree.QualifiedType; code : SyntaxTree.Code; position: LONGINT; result: BOOLEAN;
  785. BEGIN
  786. IF Trace THEN S( "Statement" ) END;
  787. CASE symbol.token OF
  788. | Scanner.Identifier, Scanner.Self, Scanner.Result:
  789. designator := Designator();
  790. position := symbol.start;
  791. IF Optional( Scanner.Becomes ) THEN
  792. expression := Expression();
  793. statement := SyntaxTree.NewAssignment( position, designator, expression,outer );
  794. CommentStatement(statement);
  795. ELSIF Peek(Scanner.ExclamationMark) OR Peek(Scanner.Questionmark) OR Peek(Scanner.LessLess) OR Peek(Scanner.GreaterGreater) THEN
  796. expression := Expression();
  797. statement := SyntaxTree.NewCommunicationStatement(position, symbol.token, designator, expression, outer);
  798. NextSymbol;
  799. CommentStatement(statement);
  800. ELSE
  801. caller := SyntaxTree.NewProcedureCallStatement(designator.position, designator,outer);
  802. statement := caller;
  803. CommentStatement(statement);
  804. END;
  805. statements.AddStatement( statement );
  806. result := TRUE
  807. | Scanner.If:
  808. NextSymbol;
  809. ifStatement := SyntaxTree.NewIfStatement( symbol.start ,outer);
  810. CommentStatement(ifStatement);
  811. expression := Expression();
  812. ifStatement.ifPart.SetCondition( expression );
  813. Check( Scanner.Then );
  814. statementSequence := StatementSequence(ifStatement);
  815. ifStatement.ifPart.SetStatements( statementSequence );
  816. WHILE Optional( Scanner.Elsif ) DO
  817. elsifPart := SyntaxTree.NewIfPart();
  818. CommentIfPart(elsifPart);
  819. ifStatement.AddElsifPart( elsifPart);
  820. expression := Expression();
  821. elsifPart.SetCondition( expression );
  822. Check( Scanner.Then );
  823. statementSequence := StatementSequence(ifStatement);
  824. elsifPart.SetStatements( statementSequence );
  825. END;
  826. IF Optional( Scanner.Else ) THEN
  827. statementSequence := StatementSequence(ifStatement);
  828. ifStatement.SetElsePart( statementSequence );
  829. END;
  830. Check( Scanner.End ); statements.AddStatement( ifStatement );
  831. result := TRUE
  832. | Scanner.With:
  833. withStatement := SyntaxTree.NewWithStatement( symbol.start ,outer);
  834. CommentStatement(withStatement);
  835. NextSymbol;
  836. REPEAT
  837. identifier := Identifier(position);
  838. IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
  839. Error(position,Diagnostics.Invalid,"forbidden qualified identifier in with statement");
  840. END;
  841. withPart := SyntaxTree.NewWithPart();
  842. CommentWithPart(withPart);
  843. withStatement.AddWithPart(withPart);
  844. designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
  845. withPart.SetVariable( designator );
  846. Check( Scanner.Colon );
  847. qualifiedIdentifier := QualifiedIdentifier();
  848. qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, currentScope, qualifiedIdentifier);
  849. withPart.SetType(qualifiedType);
  850. Check( Scanner.Do );
  851. statementSequence := StatementSequence(withStatement);
  852. withPart.SetStatements( statementSequence );
  853. UNTIL ~Optional(Scanner.Bar) OR ~CascadedWithSupport;
  854. IF CascadedWithSupport & Optional(Scanner.Else) THEN
  855. statementSequence := StatementSequence(withStatement);
  856. withStatement.SetElsePart(statementSequence);
  857. END;
  858. Check( Scanner.End );
  859. statements.AddStatement( withStatement );
  860. result := TRUE
  861. | Scanner.Case:
  862. caseStatement := SyntaxTree.NewCaseStatement( symbol.start,outer );
  863. CommentStatement(caseStatement);
  864. NextSymbol;
  865. expression := Expression();
  866. Check( Scanner.Of );
  867. caseStatement.SetVariable( expression );
  868. IF Optional(Scanner.Bar) THEN END;
  869. REPEAT
  870. Case(caseStatement)
  871. UNTIL ~Optional(Scanner.Bar);
  872. IF Optional( Scanner.Else ) THEN
  873. statementSequence := StatementSequence(caseStatement);
  874. caseStatement.SetElsePart( statementSequence );
  875. END;
  876. Check( Scanner.End );
  877. statements.AddStatement( caseStatement );
  878. result := TRUE
  879. | Scanner.While:
  880. NextSymbol;
  881. whileStatement := SyntaxTree.NewWhileStatement( symbol.start, outer );
  882. CommentStatement(whileStatement);
  883. expression := Expression();
  884. Check( Scanner.Do );
  885. whileStatement.SetCondition( expression );
  886. statementSequence := StatementSequence(whileStatement);
  887. whileStatement.SetStatements( statementSequence );
  888. Check( Scanner.End );
  889. statements.AddStatement( whileStatement );
  890. result := TRUE
  891. | Scanner.Repeat:
  892. NextSymbol;
  893. repeatStatement := SyntaxTree.NewRepeatStatement( symbol.start, outer );
  894. CommentStatement(repeatStatement);
  895. statementSequence := StatementSequence(repeatStatement);
  896. repeatStatement.SetStatements( statementSequence );
  897. Check( Scanner.Until );
  898. expression := Expression();
  899. repeatStatement.SetCondition( expression );
  900. statements.AddStatement( repeatStatement );
  901. result := TRUE
  902. | Scanner.For:
  903. NextSymbol;
  904. forStatement := SyntaxTree.NewForStatement( symbol.start, outer);
  905. CommentStatement(forStatement);
  906. identifier := Identifier(position);
  907. IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
  908. Error(position,Diagnostics.Invalid,"forbidden non-local counter variable");
  909. END;
  910. designator := SyntaxTree.NewIdentifierDesignator(position,identifier);
  911. forStatement.SetVariable( designator );
  912. Check( Scanner.Becomes );
  913. expression := Expression();
  914. forStatement.SetFrom( expression );
  915. Check( Scanner.To );
  916. expression := Expression();
  917. forStatement.SetTo( expression );
  918. IF Optional( Scanner.By ) THEN
  919. expression := Expression();
  920. forStatement.SetBy( expression );
  921. END;
  922. Check( Scanner.Do );
  923. statementSequence := StatementSequence(forStatement);
  924. forStatement.SetStatements( statementSequence );
  925. Check( Scanner.End );
  926. statements.AddStatement( forStatement );
  927. result := TRUE
  928. | Scanner.Loop:
  929. NextSymbol;
  930. loopStatement := SyntaxTree.NewLoopStatement( symbol.start ,outer);
  931. CommentStatement(loopStatement);
  932. statementSequence := StatementSequence(loopStatement);
  933. loopStatement.SetStatements( statementSequence );
  934. Check( Scanner.End );
  935. statements.AddStatement( loopStatement );
  936. result := TRUE;
  937. | Scanner.Exit:
  938. NextSymbol;
  939. statement := SyntaxTree.NewExitStatement( symbol.start, outer);
  940. CommentStatement(statement);
  941. statements.AddStatement( statement );
  942. result := TRUE;
  943. | Scanner.Return:
  944. NextSymbol;
  945. returnStatement := SyntaxTree.NewReturnStatement( symbol.start, outer);
  946. CommentStatement(returnStatement);
  947. IF (symbol.token >= Scanner.Plus) & (symbol.token <= Scanner.Identifier) THEN
  948. expression := Expression();
  949. returnStatement.SetReturnValue( expression );
  950. END;
  951. statements.AddStatement( returnStatement );
  952. result := TRUE;
  953. | Scanner.Begin:
  954. NextSymbol; statement := StatementBlock(outer); statements.AddStatement( statement ); Check( Scanner.End );
  955. result := TRUE;
  956. | Scanner.Await:
  957. awaitStatement := SyntaxTree.NewAwaitStatement( symbol.start, outer );
  958. CommentStatement(awaitStatement);
  959. NextSymbol;
  960. expression := Expression();
  961. awaitStatement.SetCondition( expression );
  962. statements.AddStatement( awaitStatement );
  963. result := TRUE
  964. | Scanner.Code:
  965. (* assemble *)
  966. code := Code(outer);
  967. Check(Scanner.End);
  968. statements.AddStatement( code );
  969. result := TRUE
  970. | Scanner.End: result := FALSE (* end of if, with, case, while, for, loop, or statement sequence *)
  971. | Scanner.Until: result := FALSE (* end of repeat *)
  972. | Scanner.Else: result := FALSE (* else of if or case *)
  973. | Scanner.Elsif: result := FALSE (* elsif of if *)
  974. | Scanner.Bar: result := FALSE (* next case *)
  975. | Scanner.Finally: result := FALSE (* end block by finally statement *)
  976. | Scanner.Semicolon: result := FALSE (* allow the empty statement *)
  977. (* builtin pseudo procedures are resolved by checker *)
  978. ELSE (* Error( symbol.start, Scanner.Semicolon, "" ); *) result := FALSE;
  979. END;
  980. IF Trace THEN E( "Statement" ) END;
  981. RETURN result
  982. END Statement;
  983. (** StatementSequence = Statement {';' Statement}. **)
  984. PROCEDURE StatementSequence*(outer: SyntaxTree.Statement ): SyntaxTree.StatementSequence;
  985. VAR statements: SyntaxTree.StatementSequence; b: BOOLEAN;
  986. BEGIN
  987. IF Trace THEN S( "StatementSequence" ) END;
  988. statements := SyntaxTree.NewStatementSequence();
  989. IF Lax THEN
  990. WHILE ~Peek(Scanner.Return) & Statement(statements,outer) DO Ignore(Scanner.Semicolon) END;
  991. IF Peek(Scanner.Return) & Statement(statements,outer) THEN Ignore(Scanner.Semicolon) END; (* return bound to end of statement sequence *)
  992. ELSE
  993. REPEAT
  994. b := Statement( statements,outer )
  995. UNTIL ~Optional( Scanner.Semicolon );
  996. END;
  997. IF Trace THEN E( "StatementSequence" ) END;
  998. RETURN statements
  999. END StatementSequence;
  1000. (** StatementBlock = [Flags] StatementSequence. **)
  1001. PROCEDURE StatementBlock(outer: SyntaxTree.Statement): SyntaxTree.StatementBlock;
  1002. VAR block: SyntaxTree.StatementBlock;
  1003. BEGIN
  1004. IF Trace THEN S( "StatementBlock" ) END;
  1005. block := SyntaxTree.NewStatementBlock( symbol.end, outer );
  1006. CommentStatement(block);
  1007. IF Optional( Scanner.LeftBrace ) THEN
  1008. block.SetModifier(Flags());
  1009. END;
  1010. block.SetStatementSequence( StatementSequence(block) );
  1011. IF Trace THEN E( "StatementBlock" ) END;
  1012. RETURN block
  1013. END StatementBlock;
  1014. (** Code = { any \ 'end' \ 'with' } ['with' {('in'|'out') StatementSequence}] . **)
  1015. PROCEDURE Code(outer: SyntaxTree.Statement): SyntaxTree.Code;
  1016. VAR startPos, endPos, i ,len: LONGINT; codeString: Scanner.StringType; code: SyntaxTree.Code;
  1017. end: Scanner.Token; in, out: BOOLEAN; left, right: SyntaxTree.Identifier;
  1018. statements, rules: SyntaxTree.StatementSequence;
  1019. BEGIN
  1020. startPos := symbol.start;
  1021. end := scanner.SkipToEndOfCode(startPos, endPos, symbol);
  1022. IF (end = Scanner.End) OR (end = Scanner.With) THEN
  1023. codeString := symbol.string;
  1024. code := SyntaxTree.NewCode(startPos,outer);
  1025. i := 0; len := LEN(codeString^);
  1026. code.SetSourceCode(codeString,len);
  1027. IF (end = Scanner.With) & Mandatory(Scanner.With) THEN
  1028. in := Optional(Scanner.In);
  1029. out := Optional(Scanner.Out);
  1030. WHILE in OR out DO
  1031. statements := StatementSequence(code);
  1032. IF in THEN rules := code.inRules ELSE rules := code.outRules END;
  1033. FOR i := 0 TO statements.Length()-1 DO
  1034. rules.AddStatement(statements.GetStatement(i));
  1035. END;
  1036. in := Optional(Scanner.In);
  1037. out := Optional(Scanner.Out);
  1038. END;
  1039. END;
  1040. END;
  1041. RETURN code;
  1042. END Code;
  1043. (** Body = 'begin' [Flags] StatementSequence ['finally' StatementSequence]
  1044. | 'code' Code. **)
  1045. PROCEDURE Body( scope: SyntaxTree.ProcedureScope ): SyntaxTree.Body;
  1046. VAR body: SyntaxTree.Body; code: SyntaxTree.Code; position: LONGINT; previousScope: SyntaxTree.Scope;
  1047. BEGIN
  1048. previousScope := currentScope;
  1049. currentScope := scope;
  1050. IF Trace THEN S( "Body" ) END;
  1051. IF Peek( Scanner.Code ) THEN
  1052. body := SyntaxTree.NewBody(symbol.start,scope); (* empty body for the time being *)
  1053. (* assemble *)
  1054. code := Code(body);
  1055. body.SetCode(code);
  1056. ELSIF Mandatory( Scanner.Begin ) THEN
  1057. body := SyntaxTree.NewBody(symbol.start,scope);
  1058. IF Optional( Scanner.LeftBrace ) THEN
  1059. body.SetModifier(Flags());
  1060. END;
  1061. position := symbol.start;
  1062. body.SetStatementSequence(StatementSequence(body));
  1063. IF Optional( Scanner.Finally ) THEN
  1064. body.SetFinally(StatementSequence(body));
  1065. END;
  1066. END;
  1067. IF Trace THEN E( "Body" ) END;
  1068. currentScope := previousScope;
  1069. RETURN body
  1070. END Body;
  1071. (** wrapper for a body in records and modules *)
  1072. PROCEDURE BodyProcedure(parentScope: SyntaxTree.Scope): SyntaxTree.Procedure;
  1073. VAR procedureScope: SyntaxTree.ProcedureScope; procedure: SyntaxTree.Procedure;
  1074. BEGIN
  1075. procedureScope := SyntaxTree.NewProcedureScope(parentScope);
  1076. IF parentScope IS SyntaxTree.ModuleScope THEN
  1077. procedure := SyntaxTree.NewProcedure( symbol.start, Global.ModuleBodyName,procedureScope);
  1078. procedure.SetAccess(SyntaxTree.Hidden);
  1079. ELSE
  1080. procedure := SyntaxTree.NewProcedure( symbol.start, Global.RecordBodyName,procedureScope);
  1081. (*! todo: make this a hidden symbol. Problematic when used with paco. *)
  1082. procedure.SetAccess(SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal);
  1083. END;
  1084. parentScope.AddProcedure(procedure);
  1085. procedure.SetType(SyntaxTree.NewProcedureType(-1,parentScope));
  1086. procedure.SetBodyProcedure(TRUE);
  1087. procedureScope.SetBody(Body(procedureScope));
  1088. RETURN procedure
  1089. END BodyProcedure;
  1090. (* ProcedureType = 'procedure' [Flags] [FormalParameters]. *)
  1091. PROCEDURE ProcedureType(position: LONGINT; parentScope: SyntaxTree.Scope): SyntaxTree.ProcedureType;
  1092. VAR procedureType: SyntaxTree.ProcedureType;
  1093. BEGIN
  1094. IF Trace THEN S( "ProcedureType" ) END;
  1095. (* procedure symbol already consumed *)
  1096. procedureType := SyntaxTree.NewProcedureType( position, parentScope);
  1097. IF Optional(Scanner.LeftBrace) THEN
  1098. procedureType.SetModifiers(Flags());
  1099. END;
  1100. IF Optional(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, parentScope) END;
  1101. IF Trace THEN E( "ProcedureType" )
  1102. END;
  1103. RETURN procedureType;
  1104. END ProcedureType;
  1105. (** ObjectType = 'object' | 'object' [Flags] ['(' (QualifiedIdentifier | ArrayType) ')'] DeclarationSequence [Body] 'end' [Identifier] . **)
  1106. PROCEDURE ObjectType(position: LONGINT; name: SyntaxTree.Identifier; parentScope: SyntaxTree.Scope ): SyntaxTree.Type;
  1107. VAR
  1108. objectType: SyntaxTree.RecordType;
  1109. pointerType: SyntaxTree.PointerType;
  1110. recordScope: SyntaxTree.RecordScope;
  1111. qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
  1112. baseType: SyntaxTree.Type;
  1113. identifier: SyntaxTree.Identifier;
  1114. str: Scanner.StringType;
  1115. type: SyntaxTree.Type;
  1116. modifiers: SyntaxTree.Modifier;
  1117. BEGIN
  1118. IF Trace THEN S( "ObjectType" ) END;
  1119. (* symbol object already consumed *)
  1120. (* generic empty OBJECT type *)
  1121. IF Peek(Scanner.Semicolon) OR Peek(Scanner.RightParenthesis) THEN
  1122. Scanner.GetKeyword(scanner.case,Scanner.Object,identifier);
  1123. qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(position,SyntaxTree.invalidIdentifier,identifier);
  1124. type := SyntaxTree.NewQualifiedType( position, parentScope, qualifiedIdentifier );
  1125. RETURN type
  1126. END;
  1127. recordScope := SyntaxTree.NewRecordScope(parentScope);
  1128. pointerType := SyntaxTree.NewPointerType(position,parentScope);
  1129. objectType := SyntaxTree.NewRecordType( position,parentScope,recordScope);
  1130. objectType.IsObject(TRUE);
  1131. objectType.SetPointerType(pointerType);
  1132. pointerType.SetPointerBase(objectType);
  1133. IF Optional(Scanner.LeftBrace) THEN
  1134. modifiers := Flags();
  1135. pointerType.SetModifiers(modifiers);
  1136. END;
  1137. IF Optional( Scanner.LeftParenthesis ) THEN
  1138. IF Optional(Scanner.Array) THEN
  1139. baseType := ArrayType(position, parentScope) (* TODO: correct position? *)
  1140. ELSE
  1141. qualifiedIdentifier := QualifiedIdentifier();
  1142. baseType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier)
  1143. END;
  1144. objectType.SetBaseType(baseType);
  1145. Check( Scanner.RightParenthesis )
  1146. END;
  1147. (*
  1148. IF Optional( Scanner.Implements ) THEN
  1149. REPEAT
  1150. qualifiedIdentifier := QualifiedIdentifier()
  1151. UNTIL ~Optional( Scanner.Comma );
  1152. END;
  1153. *)
  1154. IF Optional( Scanner.Semicolon ) THEN
  1155. (*Warning(symbol.start,Diagnostics.Invalid,"no semicolon allowed here");*)
  1156. END;
  1157. DeclarationSequence( recordScope);
  1158. IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
  1159. recordScope.SetBodyProcedure(BodyProcedure(recordScope));
  1160. END;
  1161. Check(Scanner.End);
  1162. IF ExpectThisIdentifier( name ) THEN
  1163. (* check name not always, reflect in EBNF? *)
  1164. END;
  1165. IF Trace THEN E( "ObjectType" ) END;
  1166. RETURN pointerType
  1167. END ObjectType;
  1168. (** CellType = 'cell' [Flags] [PortList] [';'] DeclarationSequence [Body] 'end' [Identifier]
  1169. | 'object'. **)
  1170. PROCEDURE CellType(position: LONGINT; name: SyntaxTree.Identifier; parentScope: SyntaxTree.Scope; isCellNet: BOOLEAN): SyntaxTree.Type;
  1171. VAR
  1172. cellType: SyntaxTree.CellType;
  1173. cellScope: SyntaxTree.CellScope;
  1174. modifiers: SyntaxTree.Modifier;
  1175. BEGIN
  1176. IF Trace THEN S( "CellType" ) END;
  1177. (* symbol cell already consumed *)
  1178. cellScope := SyntaxTree.NewCellScope(parentScope);
  1179. cellType := SyntaxTree.NewCellType( position, parentScope,cellScope);
  1180. cellType.IsCellNet(isCellNet);
  1181. cellScope.SetOwnerCell(cellType);
  1182. IF Optional(Scanner.LeftBrace) THEN
  1183. modifiers := Flags();
  1184. cellType.SetModifiers(modifiers);
  1185. END;
  1186. IF Optional( Scanner.LeftParenthesis ) THEN
  1187. PortList(cellType,cellScope);
  1188. END;
  1189. IF Optional( Scanner.Semicolon ) THEN END;
  1190. DeclarationSequence( cellScope);
  1191. IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
  1192. cellScope.SetBodyProcedure(BodyProcedure(cellScope));
  1193. END;
  1194. Check(Scanner.End);
  1195. IF ExpectThisIdentifier( name ) THEN
  1196. (* check name not always, reflect in EBNF? *)
  1197. END;
  1198. IF Trace THEN E( "CellType" ) END;
  1199. RETURN cellType
  1200. END CellType;
  1201. (** PointerType = 'pointer' [Flags] 'to' Type. **)
  1202. PROCEDURE PointerType( position: LONGINT; parentScope: SyntaxTree.Scope ): SyntaxTree.PointerType;
  1203. VAR pointerType: SyntaxTree.PointerType; base: SyntaxTree.Type; modifiers: SyntaxTree.Modifier;
  1204. BEGIN
  1205. IF Trace THEN S( "PointerType" ) END;
  1206. (* pointer symbol already consumed *)
  1207. pointerType := SyntaxTree.NewPointerType( position ,parentScope);
  1208. IF Optional(Scanner.LeftBrace) THEN
  1209. modifiers := Flags();
  1210. pointerType.SetModifiers(modifiers)
  1211. END;
  1212. Check( Scanner.To );
  1213. base := Type(SyntaxTree.invalidIdentifier, parentScope);
  1214. pointerType.SetPointerBase( base );
  1215. IF base IS SyntaxTree.RecordType THEN
  1216. base(SyntaxTree.RecordType).SetPointerType(pointerType);
  1217. END;
  1218. IF Trace THEN E( "PointerType" ) END;
  1219. RETURN pointerType
  1220. END PointerType;
  1221. (**
  1222. RecordType = 'record' [Flags] ['(' QualifiedIdentifier ')'] [VariableDeclaration {';' VariableDeclaration}] 'end'.
  1223. **)
  1224. PROCEDURE RecordType(position: LONGINT; parentScope:SyntaxTree.Scope ): SyntaxTree.RecordType;
  1225. VAR
  1226. recordType: SyntaxTree.RecordType;
  1227. recordScope: SyntaxTree.RecordScope;
  1228. qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; flags: SET; qualifiedType: SyntaxTree.QualifiedType;
  1229. modifier: SyntaxTree.Modifier;
  1230. BEGIN
  1231. IF Trace THEN S( "RecordType" ) END;
  1232. (* record symbol already consumed *)
  1233. flags := {};
  1234. recordScope := SyntaxTree.NewRecordScope(parentScope);
  1235. recordType := SyntaxTree.NewRecordType( position, parentScope, recordScope);
  1236. IF Optional( Scanner.LeftBrace ) THEN
  1237. modifier := Flags();
  1238. recordType.SetModifiers(modifier);
  1239. END;
  1240. IF Optional( Scanner.LeftParenthesis ) THEN
  1241. qualifiedIdentifier := QualifiedIdentifier();
  1242. qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
  1243. recordType.SetBaseType( qualifiedType );
  1244. Check( Scanner.RightParenthesis )
  1245. END;
  1246. IF Lax THEN
  1247. WHILE Peek(Scanner.Identifier) DO VariableDeclaration(recordScope); Ignore(Scanner.Semicolon) END;
  1248. ELSE
  1249. REPEAT
  1250. IF Peek(Scanner.Identifier) THEN VariableDeclaration( recordScope ) END;
  1251. UNTIL ~Optional( Scanner.Semicolon );
  1252. END;
  1253. Check( Scanner.End );
  1254. IF Trace THEN E( "RecordType" ) END;
  1255. RETURN recordType
  1256. END RecordType;
  1257. (** ArrayType = 'array' 'of' Type | 'array' Expression {',' Expression} 'of' Type
  1258. | 'array' '[' MathArraySize {',' MathArraySize} ']' ['of' Type].
  1259. MathArraySize = Expression | '*' | '?'.
  1260. **)
  1261. PROCEDURE ArrayType(position: LONGINT; parentScope: SyntaxTree.Scope ): SyntaxTree.Type;
  1262. VAR
  1263. arrayType: SyntaxTree.ArrayType;
  1264. type: SyntaxTree.Type;
  1265. base: SyntaxTree.Type;
  1266. expression: SyntaxTree.Expression;
  1267. PROCEDURE MathArray(): SyntaxTree.Type;
  1268. VAR mathType: SyntaxTree.MathArrayType; base: SyntaxTree.Type;
  1269. BEGIN
  1270. IF Optional(Scanner.Questionmark) THEN
  1271. mathType := SyntaxTree.NewMathArrayType(position,parentScope, SyntaxTree.Tensor);
  1272. ELSIF Optional(Scanner.Times) THEN (* open array *)
  1273. mathType := SyntaxTree.NewMathArrayType(position,parentScope, SyntaxTree.Open);
  1274. ELSE (* size given *)
  1275. mathType := SyntaxTree.NewMathArrayType(position,parentScope, SyntaxTree.Static);
  1276. expression := Expression();
  1277. mathType.SetLength(expression);
  1278. END;
  1279. IF Optional(Scanner.Comma) THEN
  1280. base := MathArray()
  1281. ELSIF Mandatory(Scanner.RightBracket) THEN
  1282. IF Optional( Scanner.Of ) THEN
  1283. base := Type(SyntaxTree.invalidIdentifier , parentScope ); (* base type *)
  1284. END;
  1285. END;
  1286. mathType.SetArrayBase(base);
  1287. RETURN mathType;
  1288. END MathArray;
  1289. BEGIN
  1290. IF Trace THEN S( "ArrayType" ) END;
  1291. (* array symbol already consumed *)
  1292. IF Optional(Scanner.LeftBracket) THEN (* math array *)
  1293. type := MathArray();
  1294. ELSIF Optional( Scanner.Of ) THEN (* open array *)
  1295. arrayType := SyntaxTree.NewArrayType(position,parentScope, SyntaxTree.Open);
  1296. type := arrayType;
  1297. base := Type( SyntaxTree.invalidIdentifier ,parentScope);
  1298. arrayType.SetArrayBase( base )
  1299. ELSE (* static array *)
  1300. arrayType := SyntaxTree.NewArrayType(position,parentScope, SyntaxTree.Static);
  1301. type := arrayType;
  1302. expression := SimpleExpression();
  1303. arrayType.SetLength( expression );
  1304. position := symbol.start;
  1305. IF Optional( Scanner.Comma ) THEN
  1306. base := ArrayType( position,parentScope);
  1307. arrayType.SetArrayBase( base )
  1308. ELSIF Mandatory( Scanner.Of ) THEN
  1309. base := Type(SyntaxTree.invalidIdentifier , parentScope ); (* base type *)
  1310. arrayType.SetArrayBase( base );
  1311. END;
  1312. END;
  1313. IF Trace THEN E( "ArrayType" ) END;
  1314. RETURN type
  1315. END ArrayType;
  1316. (** EnumerationType = 'enum' ['('QualifiedIdentifier')'] IdentifierDefinition ['=' Expression]
  1317. {',' IdentifierDefinition ['=' Expression]} 'end'. *)
  1318. PROCEDURE EnumerationType(position: LONGINT; parentScope: SyntaxTree.Scope): SyntaxTree.Type;
  1319. VAR type: SyntaxTree.EnumerationType; scope: SyntaxTree.EnumerationScope; identifier: SyntaxTree.Identifier;
  1320. qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; qualifiedType: SyntaxTree.QualifiedType; access: SET;
  1321. constant: SyntaxTree.Constant; expression: SyntaxTree.Expression;
  1322. BEGIN
  1323. (* enum symbol already consumed *)
  1324. scope := SyntaxTree.NewEnumerationScope(parentScope);
  1325. type := SyntaxTree.NewEnumerationType(position,parentScope, scope);
  1326. IF Optional( Scanner.LeftParenthesis ) THEN
  1327. qualifiedIdentifier := QualifiedIdentifier();
  1328. qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
  1329. type.SetEnumerationBase( qualifiedType );
  1330. Check( Scanner.RightParenthesis )
  1331. END;
  1332. REPEAT
  1333. IdentifierDefinition(identifier,access,FALSE);
  1334. position := symbol.start;
  1335. constant := SyntaxTree.NewConstant( position, identifier );
  1336. CommentSymbol(constant);
  1337. constant.SetAccess(access);
  1338. IF Optional(Scanner.Equal) THEN
  1339. expression := Expression();
  1340. constant.SetValue( expression );
  1341. END;
  1342. scope.AddConstant( constant );
  1343. UNTIL ~Optional(Scanner.Comma);
  1344. IF Mandatory(Scanner.End) THEN END;
  1345. RETURN type
  1346. END EnumerationType;
  1347. (** PortType = 'port' ('in'|'out') ['(' Expression ')'] *)
  1348. PROCEDURE PortType(position: LONGINT; parentScope: SyntaxTree.Scope): SyntaxTree.Type;
  1349. VAR type: SyntaxTree.Type; direction: LONGINT; sizeExpression: SyntaxTree.Expression;
  1350. BEGIN
  1351. (* port symbol already consumed *)
  1352. IF Optional(Scanner.In) THEN
  1353. direction := SyntaxTree.InPort
  1354. ELSIF Optional(Scanner.Out) THEN
  1355. direction := SyntaxTree.OutPort
  1356. ELSE
  1357. Error(position,Diagnostics.Invalid,"invalid direction, expected IN or OUT");
  1358. END;
  1359. IF Optional(Scanner.LeftParenthesis) THEN
  1360. sizeExpression := Expression();
  1361. IF Mandatory(Scanner.RightParenthesis )THEN END;
  1362. END;
  1363. type := SyntaxTree.NewPortType(position, direction, sizeExpression, parentScope);
  1364. RETURN type
  1365. END PortType;
  1366. (** Type = ArrayType | RecordType | PointerType | ObjectType | CellType | CellnetType | PortType
  1367. | ProcedureType | EnumerationType | QualifiedIdentifier. *)
  1368. PROCEDURE Type( name: SyntaxTree.Identifier; parentScope: SyntaxTree.Scope ): SyntaxTree.Type;
  1369. VAR type: SyntaxTree.Type; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier; position: LONGINT;
  1370. BEGIN
  1371. IF Trace THEN S( "Type" ) END;
  1372. position := symbol.start;
  1373. IF Optional( Scanner.Array ) THEN type := ArrayType( position,parentScope );
  1374. ELSIF Optional( Scanner.Record ) THEN type := RecordType( position,parentScope );
  1375. ELSIF Optional( Scanner.Pointer ) THEN type := PointerType( position,parentScope );
  1376. ELSIF Optional( Scanner.Object ) THEN type := ObjectType( position,name,parentScope );
  1377. ELSIF Optional( Scanner.Cell) THEN type := CellType( position, name, parentScope,FALSE);
  1378. ELSIF Optional( Scanner.CellNet) THEN type := CellType( position, name, parentScope, TRUE);
  1379. ELSIF Optional( Scanner.Port) THEN type := PortType( position, parentScope)
  1380. ELSIF Optional( Scanner.Procedure ) THEN type := ProcedureType( position,parentScope);
  1381. ELSIF Optional( Scanner.Enum ) THEN type := EnumerationType( position,parentScope);
  1382. ELSIF (symbol.token = Scanner.Address) OR (symbol.token = Scanner.Size) THEN
  1383. qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(position,SyntaxTree.invalidIdentifier, symbol.identifier);
  1384. type := SyntaxTree.NewQualifiedType( qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
  1385. NextSymbol;
  1386. ELSE qualifiedIdentifier := QualifiedIdentifier();
  1387. type := SyntaxTree.NewQualifiedType( qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
  1388. END;
  1389. IF Trace THEN E( "Type" ) END;
  1390. RETURN type
  1391. END Type;
  1392. (** PortDeclaration = Identifier [Flags] {',' Identifier [Flags]}':' Type. **)
  1393. PROCEDURE PortDeclaration(cell: SyntaxTree.CellType; parentScope: SyntaxTree.Scope);
  1394. VAR
  1395. type: SyntaxTree.Type; name: SyntaxTree.Identifier;
  1396. firstParameter, parameter: SyntaxTree.Parameter;
  1397. position: LONGINT; modifiers: SyntaxTree.Modifier;
  1398. BEGIN
  1399. IF Trace THEN S( "PortDeclaration" ) END;
  1400. firstParameter := cell.lastParameter;
  1401. REPEAT
  1402. name := Identifier(position);
  1403. parameter := SyntaxTree.NewParameter(position,cell,name,SyntaxTree.ValueParameter);
  1404. cell.AddParameter(parameter);
  1405. IF Optional(Scanner.LeftBrace) THEN
  1406. modifiers := Flags();
  1407. parameter.SetModifiers(modifiers);
  1408. END;
  1409. UNTIL ~Optional( Scanner.Comma );
  1410. Check( Scanner.Colon );
  1411. type := Type( SyntaxTree.invalidIdentifier, parentScope);
  1412. ASSERT(type # NIL);
  1413. IF firstParameter # NIL THEN parameter := firstParameter.nextParameter ELSE parameter := cell.firstParameter END;
  1414. WHILE parameter # NIL DO
  1415. parameter.SetType( type );
  1416. parameter := parameter.nextParameter;
  1417. END;
  1418. IF Trace THEN E( "PortDeclaration" )
  1419. END;
  1420. END PortDeclaration;
  1421. (** PortList = '(' [PortDeclaration {';' PortDeclaration}] ')'. **)
  1422. PROCEDURE PortList( cell: SyntaxTree.CellType ; parentScope: SyntaxTree.Scope);
  1423. BEGIN
  1424. IF Trace THEN S( "PortList" ) END;
  1425. (* left parenthesis already consumed *)
  1426. IF ~Optional( Scanner.RightParenthesis ) THEN
  1427. IF Lax THEN
  1428. WHILE Peek(Scanner.Identifier) OR Peek(Scanner.Var) OR Peek(Scanner.Const) DO PortDeclaration( cell, parentScope ); Ignore(Scanner.Semicolon) END;
  1429. ELSE
  1430. REPEAT PortDeclaration( cell, parentScope ); UNTIL ~Optional( Scanner.Semicolon );
  1431. END;
  1432. Check( Scanner.RightParenthesis );
  1433. END;
  1434. IF Trace THEN E( "PortList" ) END;
  1435. END PortList;
  1436. (** ParameterDeclaration = ['var'|'const'] Identifier [Flags] ['= Expression] {',' Identifier [Flags] ['= Expression]}':' Type.**)
  1437. PROCEDURE ParameterDeclaration( procedureType: SyntaxTree.ProcedureType ; parentScope: SyntaxTree.Scope);
  1438. VAR
  1439. type: SyntaxTree.Type; name: SyntaxTree.Identifier;
  1440. firstParameter, parameter: SyntaxTree.Parameter; kind,position: LONGINT;
  1441. BEGIN
  1442. IF Trace THEN S( "ParameterDeclaration" ) END;
  1443. IF Optional( Scanner.Var ) THEN (* var parameter *)
  1444. kind := SyntaxTree.VarParameter
  1445. ELSIF Optional( Scanner.Const ) THEN (* const parameter *)
  1446. kind := SyntaxTree.ConstParameter
  1447. ELSIF symbol.token # Scanner.Identifier THEN
  1448. Error(symbol.start,Scanner.Identifier,"");
  1449. RETURN
  1450. ELSE kind := SyntaxTree.ValueParameter
  1451. END;
  1452. firstParameter := procedureType.lastParameter;
  1453. REPEAT
  1454. name := Identifier(position);
  1455. parameter := SyntaxTree.NewParameter(position,procedureType,name,kind);
  1456. IF Optional(Scanner.LeftBrace) THEN parameter.SetModifiers(Flags()) END;
  1457. procedureType.AddParameter(parameter);
  1458. IF Optional(Scanner.Equal) THEN
  1459. parameter.SetDefaultValue(Expression());
  1460. END
  1461. UNTIL ~Optional( Scanner.Comma );
  1462. Check( Scanner.Colon );
  1463. type := Type( SyntaxTree.invalidIdentifier, parentScope);
  1464. CommentSymbol(parameter);
  1465. ASSERT(type # NIL);
  1466. IF firstParameter # NIL THEN parameter := firstParameter.nextParameter ELSE parameter := procedureType.firstParameter END;
  1467. WHILE parameter # NIL DO
  1468. parameter.SetType( type );
  1469. parameter := parameter.nextParameter;
  1470. END;
  1471. IF Trace THEN E( "ParameterDeclaration" )
  1472. END;
  1473. END ParameterDeclaration;
  1474. (** FormalParameters = '(' [ParameterDeclaration {';' ParameterDeclaration}] ')' [':' [Flags] Type]. **)
  1475. PROCEDURE FormalParameters( procedureType: SyntaxTree.ProcedureType ; parentScope: SyntaxTree.Scope);
  1476. VAR type: SyntaxTree.Type; position: LONGINT;
  1477. BEGIN
  1478. IF Trace THEN S( "FormalParameters" ) END;
  1479. (* left parenthesis already consumed *)
  1480. IF ~Optional( Scanner.RightParenthesis ) THEN
  1481. IF Lax THEN
  1482. WHILE Peek(Scanner.Identifier) OR Peek(Scanner.Const) OR Peek(Scanner.Var) DO
  1483. ParameterDeclaration(procedureType, parentScope); Ignore(Scanner.Semicolon)
  1484. END;
  1485. ELSE
  1486. REPEAT ParameterDeclaration( procedureType, parentScope ); UNTIL ~Optional( Scanner.Semicolon );
  1487. END;
  1488. Check( Scanner.RightParenthesis );
  1489. END;
  1490. IF Optional( Scanner.Colon ) THEN
  1491. position:= symbol.start;
  1492. IF Optional( Scanner.LeftBrace) THEN
  1493. procedureType.SetReturnTypeModifiers(Flags());
  1494. END;
  1495. type := Type(SyntaxTree.invalidIdentifier,parentScope);
  1496. (* formally, any type is permitted as return type. Actually some of them might simply not be usable *)
  1497. procedureType.SetReturnType(type);
  1498. END;
  1499. IF Trace THEN E( "FormalParameters" ) END;
  1500. END FormalParameters;
  1501. (** Flags = '{' [Identifier ['(' Expression ')'|'=' Expression] {',' Identifier ['(' Expression ')' | '=' Expression ] } ] '}'. **)
  1502. PROCEDURE Flags(): SyntaxTree.Modifier;
  1503. VAR identifier: SyntaxTree.Identifier; modifier,list: SyntaxTree.Modifier; position: LONGINT; expression: SyntaxTree.Expression;
  1504. BEGIN
  1505. IF Trace THEN S( "Flags" ) END;
  1506. (* left brace already consumed *)
  1507. list := NIL;
  1508. IF Peek(Scanner.RightBrace) THEN (* empty flags *)
  1509. ELSE
  1510. REPEAT
  1511. position := symbol.start;
  1512. identifier := Identifier(position);
  1513. IF Optional(Scanner.LeftParenthesis) THEN
  1514. expression := Expression();
  1515. Check(Scanner.RightParenthesis)
  1516. ELSIF Optional(Scanner.Equal) THEN
  1517. expression := Expression();
  1518. ELSE
  1519. expression := NIL
  1520. END;
  1521. modifier := SyntaxTree.NewModifier(position,identifier,expression);
  1522. AppendModifier(list,modifier);
  1523. UNTIL ~Optional( Scanner.Comma ) & ~Optional(Scanner.Semicolon);
  1524. END;
  1525. Check(Scanner.RightBrace);
  1526. IF Trace THEN E( "Flags" ) END;
  1527. RETURN list;
  1528. END Flags;
  1529. PROCEDURE SetNextInComment(c: SyntaxTree.Comment; this: ANY);
  1530. BEGIN
  1531. WHILE c # NIL DO
  1532. c.SetItem(this,FALSE);
  1533. c := c.nextComment
  1534. END;
  1535. END SetNextInComment;
  1536. PROCEDURE CommentSymbol(symbol: SyntaxTree.Symbol);
  1537. BEGIN
  1538. IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
  1539. symbol.SetComment(recentComment);
  1540. SetNextInComment(recentComment, symbol);
  1541. recentComment := NIL
  1542. END;
  1543. recentLine := scanner.line;
  1544. recentCommentItem := symbol;
  1545. END CommentSymbol;
  1546. PROCEDURE CommentStatement(symbol: SyntaxTree.Statement);
  1547. BEGIN
  1548. IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
  1549. symbol.SetComment(recentComment);
  1550. SetNextInComment(recentComment, symbol);
  1551. recentComment := NIL
  1552. END;
  1553. recentLine := scanner.line;
  1554. recentCommentItem := symbol
  1555. END CommentStatement;
  1556. PROCEDURE CommentCasePart(symbol: SyntaxTree.CasePart);
  1557. BEGIN
  1558. IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
  1559. symbol.SetComment(recentComment);
  1560. SetNextInComment(recentComment, symbol);
  1561. recentComment := NIL
  1562. END;
  1563. recentLine := scanner.line;
  1564. recentCommentItem := symbol
  1565. END CommentCasePart;
  1566. PROCEDURE CommentIfPart(symbol: SyntaxTree.IfPart);
  1567. BEGIN
  1568. IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
  1569. symbol.SetComment(recentComment);
  1570. SetNextInComment(recentComment, symbol);
  1571. recentComment := NIL
  1572. END;
  1573. recentLine := scanner.line;
  1574. recentCommentItem := symbol
  1575. END CommentIfPart;
  1576. PROCEDURE CommentWithPart(symbol: SyntaxTree.WithPart);
  1577. BEGIN
  1578. IF (recentComment # NIL) (* & (recentComment.nextSymbol = NIL) *) THEN
  1579. symbol.SetComment(recentComment);
  1580. SetNextInComment(recentComment, symbol);
  1581. recentComment := NIL
  1582. END;
  1583. recentLine := scanner.line;
  1584. recentCommentItem := symbol
  1585. END CommentWithPart;
  1586. (** ProcedureDeclaration = 'procedure' ['^'|'&'|'~'|'-'|Flags ['-']] IdentifierDefinition [FormalParameters]';'
  1587. DeclarationSequence [Body] 'end' Identifier.
  1588. Forward declarations ignored.
  1589. **)
  1590. PROCEDURE ProcedureDeclaration( parentScope: SyntaxTree.Scope);
  1591. VAR name: SyntaxTree.Identifier;
  1592. procedure: SyntaxTree.Procedure;
  1593. procedureType: SyntaxTree.ProcedureType;
  1594. procedureScope : SyntaxTree.ProcedureScope;
  1595. access: SET;
  1596. position: LONGINT;
  1597. isConstructor: BOOLEAN;
  1598. isFinalizer: BOOLEAN;
  1599. isInline: BOOLEAN;
  1600. modifiers: SyntaxTree.Modifier;
  1601. forwardDeclaration: BOOLEAN;
  1602. string: Scanner.StringType;
  1603. BEGIN
  1604. IF Trace THEN S( "Procedure" ) END;
  1605. (* symbol procedure has already been consumed *)
  1606. modifiers := NIL;
  1607. isConstructor := FALSE; isFinalizer := FALSE; isInline := FALSE;
  1608. procedureType := SyntaxTree.NewProcedureType(symbol.start, parentScope);
  1609. IF Optional( Scanner.Arrow) THEN (* ignore forward declarations *)
  1610. forwardDeclaration := TRUE;
  1611. ELSE forwardDeclaration := FALSE;
  1612. END;
  1613. IF Optional( Scanner.And ) THEN (* constructor *)
  1614. isConstructor := TRUE
  1615. ELSIF Optional( Scanner.Not ) THEN (* finalizer *)
  1616. isFinalizer := TRUE
  1617. ELSIF Optional( Scanner.Minus ) THEN (* inline *)
  1618. isInline := TRUE;
  1619. ELSIF Optional( Scanner.LeftBrace) THEN
  1620. modifiers := Flags();
  1621. IF Optional( Scanner.Minus ) THEN (* inline *)
  1622. isInline := TRUE
  1623. END;
  1624. END;
  1625. IF Peek(Scanner.String) OR Peek(Scanner.Character) THEN (* for compatibility with release *)
  1626. OperatorDeclaration( parentScope ); RETURN
  1627. END;
  1628. position:= symbol.start;
  1629. IdentifierDefinition( name, access,TRUE);
  1630. procedureScope := SyntaxTree.NewProcedureScope(parentScope);
  1631. procedure := SyntaxTree.NewProcedure( position, name, procedureScope);
  1632. procedure.SetConstructor(isConstructor);
  1633. procedure.SetFinalizer(isFinalizer);
  1634. procedure.SetInline(isInline);
  1635. CommentSymbol(procedure);
  1636. procedure.SetAccess(access);
  1637. procedureType.SetModifiers(modifiers);
  1638. procedure.SetType(procedureType);
  1639. IF Optional(Scanner.Extern) & MandatoryString(string) THEN procedure.SetExternalName(string); END;
  1640. IF Optional(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, procedureScope) END;
  1641. IF (procedure.externalName = NIL) & ~forwardDeclaration THEN
  1642. IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
  1643. DeclarationSequence( procedureScope);
  1644. IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
  1645. procedureScope.SetBody(Body(procedureScope));
  1646. END;
  1647. Check(Scanner.End);
  1648. IF ExpectThisIdentifier( name ) THEN END;
  1649. END;
  1650. parentScope.AddProcedure( procedure );
  1651. IF Trace THEN E( "Procedure") END;
  1652. END ProcedureDeclaration;
  1653. (** OperatorDeclaration = 'operator' [Flags] ['-'] String ['*'|'-'] FormalParameters ';'
  1654. DeclarationSequence [Body] 'end' String.
  1655. **)
  1656. PROCEDURE OperatorDeclaration(parentScope: SyntaxTree.Scope );
  1657. VAR
  1658. string: Scanner.StringType;
  1659. procedureScope: SyntaxTree.ProcedureScope;
  1660. procedureType: SyntaxTree.ProcedureType;
  1661. operator: SyntaxTree.Operator;
  1662. access: SET;
  1663. i: LONGINT; ch: CHAR; position: LONGINT;
  1664. modifiers: SyntaxTree.Modifier; (* nopov *)
  1665. isInline, forward: BOOLEAN;
  1666. BEGIN
  1667. IF Trace THEN S( "Operator" ) END;
  1668. (* symbol operator already consumed *)
  1669. position := symbol.start;
  1670. forward := Optional(Scanner.Arrow);
  1671. isInline := FALSE;
  1672. IF Optional( Scanner.LeftBrace) THEN
  1673. modifiers := Flags();
  1674. END;
  1675. IF Optional( Scanner.Minus ) THEN (* inline *)
  1676. isInline := TRUE
  1677. END;
  1678. IF MandatoryString( string ) THEN
  1679. (* copy string to name and check for length. LEN(name)>0, LEN(string)>0 can be presumed *)
  1680. i := 0; WHILE (string^[i] # 0X) DO INC(i) END;
  1681. IF i >= Scanner.MaxIdentifierLength THEN (* string too long to act as operator identifier *)
  1682. Error(symbol.start,Basic.StringTooLong,"");
  1683. END
  1684. END;
  1685. IF Optional( Scanner.Times ) THEN access := SyntaxTree.ReadOnly;
  1686. ELSIF Optional( Scanner.Minus ) THEN access := SyntaxTree.ReadOnly;
  1687. ELSE access := SyntaxTree.Internal;
  1688. END;
  1689. procedureScope := SyntaxTree.NewProcedureScope(parentScope);
  1690. operator := SyntaxTree.NewOperator( symbol.start, SyntaxTree.NewIdentifier(string^), procedureScope);
  1691. CommentSymbol(operator);
  1692. operator.SetAccess(access);
  1693. procedureType := SyntaxTree.NewProcedureType(symbol.start,parentScope);
  1694. IF Mandatory(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, procedureScope ) END;
  1695. procedureType.SetModifiers(modifiers); (* nopov *)
  1696. operator.SetType( procedureType );
  1697. operator.SetInline(isInline);
  1698. IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
  1699. IF ~forward THEN
  1700. DeclarationSequence( procedureScope );
  1701. IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
  1702. procedureScope.SetBody(Body(procedureScope));
  1703. END;
  1704. IF Mandatory(Scanner.End) & ExpectThisString(string^) THEN END;
  1705. END;
  1706. parentScope.AddProcedure(operator);
  1707. IF parentScope IS SyntaxTree.ModuleScope THEN
  1708. parentScope(SyntaxTree.ModuleScope).AddOperator(operator);
  1709. ELSIF parentScope IS SyntaxTree.RecordScope THEN
  1710. parentScope(SyntaxTree.RecordScope).AddOperator(operator);
  1711. ELSE
  1712. Error(position,Diagnostics.Invalid,"Operators only allowed in module or record scope"); (* nopov *)
  1713. END;
  1714. IF Trace THEN EE( "Operator", string^ ) END;
  1715. END OperatorDeclaration;
  1716. (** VariableNameList = IdentifierDefinition [Flags] [':=' Expression | 'extern' String] {',' IdentifierDefinition [Flags] [':=' Expression | 'extern' String] }.**)
  1717. PROCEDURE VariableNameList( scope: SyntaxTree.Scope );
  1718. VAR varname: SyntaxTree.Identifier; position: LONGINT; variable: SyntaxTree.Variable; flags,access: SET; string: Scanner.StringType;
  1719. BEGIN
  1720. IF Trace THEN S( "VariableNameList" ) END;
  1721. REPEAT
  1722. flags := {};
  1723. position := symbol.start;
  1724. IdentifierDefinition( varname, access,TRUE);
  1725. variable := SyntaxTree.NewVariable( position, varname );
  1726. CommentSymbol(variable);
  1727. IF Optional(Scanner.LeftBrace) THEN variable.SetModifiers(Flags()) END;
  1728. IF Optional(Scanner.Becomes) THEN variable.SetInitializer (Expression());
  1729. ELSIF Optional(Scanner.Extern) & MandatoryString(string) THEN variable.SetExternalName(string); END;
  1730. variable.SetAccess(access);
  1731. scope.AddVariable(variable);
  1732. UNTIL ~Optional( Scanner.Comma );
  1733. IF Trace THEN E( "VariableNameList" ) END;
  1734. END VariableNameList;
  1735. (** VariableDeclaration = VariableNameList ':' Type. **)
  1736. PROCEDURE VariableDeclaration(parentScope: SyntaxTree.Scope );
  1737. VAR
  1738. variable, firstVariable: SyntaxTree.Variable; type: SyntaxTree.Type;
  1739. BEGIN
  1740. IF Trace THEN S( "VariableDeclaration" ) END;
  1741. firstVariable := parentScope.lastVariable;
  1742. VariableNameList( parentScope );
  1743. Check( Scanner.Colon );
  1744. type := Type( SyntaxTree.invalidIdentifier, parentScope );
  1745. variable := firstVariable;
  1746. IF firstVariable # NIL THEN variable := firstVariable.nextVariable ELSE variable := parentScope.firstVariable END;
  1747. WHILE variable # NIL DO
  1748. variable.SetType( type );
  1749. variable := variable.nextVariable;
  1750. END;
  1751. IF Trace THEN E( "VariableDeclaration" ) END;
  1752. END VariableDeclaration;
  1753. (** TypeDeclaration = IdentifierDefinition '=' Type.**)
  1754. PROCEDURE TypeDeclaration(parentScope: SyntaxTree.Scope);
  1755. VAR name: SyntaxTree.Identifier; position: LONGINT; type: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration; access: SET;
  1756. BEGIN
  1757. IF Trace THEN S( "TypeDeclaration" ) END;
  1758. position := symbol.start;
  1759. IdentifierDefinition( name, access,FALSE);
  1760. typeDeclaration := SyntaxTree.NewTypeDeclaration( position,name);
  1761. CommentSymbol(typeDeclaration);
  1762. Check( Scanner.Equal );
  1763. type := Type( name , parentScope);
  1764. type.SetTypeDeclaration(typeDeclaration);
  1765. typeDeclaration.SetDeclaredType(type);
  1766. (*
  1767. type.SetName(typeDeclaration.name); (* don't do that: overwrites global names ! *)
  1768. *)
  1769. typeDeclaration.SetAccess(access);
  1770. parentScope.AddTypeDeclaration( typeDeclaration );
  1771. IF Trace THEN E( "TypeDeclaration" ) END;
  1772. END TypeDeclaration;
  1773. (** ConstDeclaration = IdentifierDefinition '=' Expression. **)
  1774. PROCEDURE ConstDeclaration(parentScope: SyntaxTree.Scope );
  1775. VAR name: SyntaxTree.Identifier; position: LONGINT; constant: SyntaxTree.Constant; expression: SyntaxTree.Expression; access: SET;
  1776. BEGIN
  1777. IF Trace THEN S( "ConstDeclaration" ) END;
  1778. IdentifierDefinition( name, access, FALSE);
  1779. position := symbol.start;
  1780. constant := SyntaxTree.NewConstant( position, name );
  1781. CommentSymbol(constant);
  1782. constant.SetAccess(access);
  1783. Check( Scanner.Equal );
  1784. expression := Expression();
  1785. constant.SetValue( expression );
  1786. parentScope.AddConstant( constant );
  1787. IF Trace THEN E( "ConstDeclaration" ) END;
  1788. END ConstDeclaration;
  1789. (** DeclarationSequence = { 'const' [ConstDeclaration] {';' [ConstDeclaration]}
  1790. |'type' [TypeDeclaration] {';' [TypeDeclaration]}
  1791. |'var' [VariableDeclaration] {';' [VariableDeclaration]}
  1792. | ProcedureDeclaration
  1793. | OperatorDeclaration
  1794. | ';'
  1795. }
  1796. **)
  1797. PROCEDURE DeclarationSequence( parentScope: SyntaxTree.Scope);
  1798. VAR previousScope: SyntaxTree.Scope;
  1799. BEGIN
  1800. previousScope := currentScope;
  1801. currentScope := parentScope;
  1802. IF Trace THEN S( "DeclarationSequence" ) END;
  1803. IF Lax THEN
  1804. LOOP
  1805. Ignore(Scanner.Semicolon);
  1806. IF Optional(Scanner.Const) THEN
  1807. WHILE Peek(Scanner.Identifier) DO ConstDeclaration(parentScope); Ignore(Scanner.Semicolon) END;
  1808. ELSIF Optional(Scanner.Type) THEN
  1809. WHILE Peek(Scanner.Identifier) DO TypeDeclaration(parentScope); Ignore(Scanner.Semicolon) END;
  1810. ELSIF Optional(Scanner.Var) THEN
  1811. WHILE Peek(Scanner.Identifier) DO VariableDeclaration(parentScope); Ignore(Scanner.Semicolon); END;
  1812. ELSIF Optional(Scanner.Procedure) THEN
  1813. ProcedureDeclaration(parentScope); Ignore(Scanner.Semicolon)
  1814. ELSIF Optional(Scanner.Operator) THEN
  1815. OperatorDeclaration(parentScope); Ignore(Scanner.Semicolon);
  1816. ELSE
  1817. EXIT
  1818. END;
  1819. END;
  1820. ELSE
  1821. LOOP
  1822. IF Optional( Scanner.Const ) THEN
  1823. REPEAT
  1824. IF Peek(Scanner.Identifier) THEN ConstDeclaration( parentScope ) END
  1825. UNTIL ~Optional( Scanner.Semicolon )
  1826. ELSIF Optional( Scanner.Type ) THEN
  1827. REPEAT
  1828. IF Peek(Scanner.Identifier) THEN TypeDeclaration( parentScope) END
  1829. UNTIL ~Optional( Scanner.Semicolon )
  1830. ELSIF Optional( Scanner.Var ) THEN
  1831. REPEAT
  1832. IF Peek(Scanner.Identifier) THEN VariableDeclaration( parentScope ) END
  1833. UNTIL ~Optional( Scanner.Semicolon )
  1834. ELSIF Optional(Scanner.Operator) THEN
  1835. OperatorDeclaration( parentScope);
  1836. ELSIF Optional( Scanner.Procedure ) THEN
  1837. ProcedureDeclaration( parentScope );
  1838. ELSE EXIT
  1839. END;
  1840. Ignore(Scanner.Semicolon)
  1841. END;
  1842. END;
  1843. currentScope := previousScope;
  1844. IF Trace THEN E( "DeclarationSequence" ) END;
  1845. END DeclarationSequence;
  1846. (**
  1847. ImportList = 'import' Import { ',' Import } ';'.
  1848. Import = Identifier [':=' Identifier] ['in' Identifier].
  1849. **)
  1850. PROCEDURE ImportList( moduleScope: SyntaxTree.ModuleScope );
  1851. VAR alias, name, context: SyntaxTree.Identifier; import: SyntaxTree.Import; position,idPosition: LONGINT;
  1852. BEGIN
  1853. IF Trace THEN S( "ImportList" ) END;
  1854. (* import symbol already consumed *)
  1855. REPEAT
  1856. position := symbol.start;
  1857. alias := Identifier(idPosition);
  1858. IF alias # SyntaxTree.invalidIdentifier THEN
  1859. IF Optional( Scanner.Becomes ) THEN name := Identifier(idPosition) ELSE name := alias; END;
  1860. import := SyntaxTree.NewImport( position, alias, name, TRUE );
  1861. CommentSymbol(import);
  1862. IF Optional(Scanner.In) THEN
  1863. position := symbol.start;
  1864. context := Identifier(idPosition);
  1865. IF context # SyntaxTree.invalidIdentifier THEN import.SetContext(context) END;
  1866. END;
  1867. moduleScope.AddImport( import );
  1868. END;
  1869. UNTIL ~Optional( Scanner.Comma );
  1870. IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
  1871. IF Trace THEN E( "ImportList" ); END;
  1872. END ImportList;
  1873. (** Module = ('module' | 'cellnet' [Flags]) Identifier ['in' Identifier]';'
  1874. [ImportList] DeclarationSequence [Body]
  1875. 'end' Identifier '.'.
  1876. **)
  1877. PROCEDURE Module*(): SyntaxTree.Module;
  1878. VAR moduleName, context: SyntaxTree.Identifier; module: SyntaxTree.Module; position: LONGINT; isCellNet: BOOLEAN;
  1879. scannerDiagnostics: Diagnostics.Diagnostics; modifiers: SyntaxTree.Modifier; c: SyntaxTree.Comment;
  1880. BEGIN
  1881. IF Trace THEN S( "Module" ) END;
  1882. position := symbol.start;
  1883. moduleScope := SyntaxTree.NewModuleScope(); (* needed to feed in comment already before module starts *)
  1884. currentScope := moduleScope;
  1885. isCellNet := Optional(Scanner.CellNet);
  1886. IF isCellNet OR Mandatory( Scanner.Module ) THEN
  1887. (*c := recentComment; recentComment := NIL;*)
  1888. IF isCellNet & Optional(Scanner.LeftBrace) THEN modifiers := Flags() ELSE modifiers := NIL END;
  1889. moduleName := Identifier(position);
  1890. module := SyntaxTree.NewModule( scanner.source^, position, moduleName, moduleScope, scanner.case );
  1891. CommentSymbol(module);
  1892. (*
  1893. module.SetComment(c);
  1894. SetNextInComment(c, module);
  1895. *)
  1896. IF isCellNet THEN module.SetCellNet(TRUE); module.SetModifiers(modifiers); END;
  1897. module.SetType(SyntaxTree.moduleType);
  1898. IF Optional(Scanner.In) THEN
  1899. position := symbol.start;
  1900. context := Identifier(position);
  1901. module.SetContext(context);
  1902. END;
  1903. IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check(Scanner.Semicolon) END;
  1904. IF ~Peek(Scanner.EndOfText) THEN
  1905. module.SetClosingComment(recentComment);
  1906. SetNextInComment(recentComment, module);
  1907. recentComment := NIL;
  1908. END;
  1909. IF Optional(Scanner.Import) THEN ImportList(moduleScope) END;
  1910. DeclarationSequence( moduleScope);
  1911. IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
  1912. moduleScope.SetBodyProcedure(BodyProcedure(moduleScope)); (* insert empty body procedure if necessary *)
  1913. END;
  1914. Check(Scanner.End);
  1915. IF ExpectThisIdentifier( moduleName ) THEN
  1916. IF symbol.token # Scanner.Period THEN
  1917. Error( symbol.start, Scanner.Period, "" )
  1918. ELSIF ~error & ~scanner.error THEN (* read ahead to read comments and to check for next module *)
  1919. scanner.ResetCase;
  1920. scannerDiagnostics := NIL;
  1921. scanner.ResetErrorDiagnostics(scannerDiagnostics);
  1922. NextSymbol;
  1923. scanner.ResetErrorDiagnostics(scannerDiagnostics);
  1924. END;
  1925. (*
  1926. (* do not use Check for not reading after end of module *)
  1927. IF ~Peek(Scanner.Module) & ~Peek(Scanner.CellNet) THEN
  1928. SetNextInComment(recentComment,module);
  1929. module.SetClosingComment(recentComment);
  1930. recentComment := NIL;
  1931. END;
  1932. *)
  1933. END;
  1934. END;
  1935. IF Trace THEN E( "Module" ) END;
  1936. RETURN module
  1937. END Module;
  1938. (** check if another module declaration is available after recent module parsing -> for parsing and compiling multiple modules within a single file **)
  1939. PROCEDURE NextModule*(): BOOLEAN;
  1940. BEGIN
  1941. RETURN Peek(Scanner.Module) OR Peek(Scanner.CellNet);
  1942. END NextModule;
  1943. END Parser;
  1944. (* utilities *)
  1945. PROCEDURE AppendModifier(VAR list: SyntaxTree.Modifier; modifier: SyntaxTree.Modifier);
  1946. VAR this, next: SyntaxTree.Modifier;
  1947. BEGIN
  1948. IF list = NIL THEN list := modifier
  1949. ELSE
  1950. this := list;
  1951. next := list.nextModifier;
  1952. WHILE next # NIL DO
  1953. this := next;
  1954. next := this.nextModifier;
  1955. END;
  1956. this.SetNext(modifier);
  1957. END;
  1958. END AppendModifier;
  1959. (** parser retrieval **)
  1960. PROCEDURE NewParser*( scanner: Scanner.Scanner; diagnostics: Diagnostics.Diagnostics): Parser;
  1961. VAR parser: Parser;
  1962. BEGIN
  1963. NEW( parser, scanner, diagnostics ); RETURN parser;
  1964. END NewParser;
  1965. END FoxParser.