FoxParser.Mod 87 KB

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