FoxParser.Mod 84 KB

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