FoxParser.Mod 92 KB

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