FoxParser.Mod 80 KB

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