FoxParser.Mod 93 KB

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