FoxParser.Mod 87 KB

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