FoxParser.Mod 81 KB

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