FoxParser.Mod 86 KB

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