FoxParser.Mod 84 KB

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