FoxParser.Mod 84 KB

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