FoxParser.Mod 84 KB

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