├── README.md ├── LICENSE └── Source └── paspargen.dpr /README.md: -------------------------------------------------------------------------------- 1 | PASPARGEN 2 | ============ 3 | 4 | _PASPARGEN_ is a parser generator written in Object Pascal, capable of generating parsers also in Objective Pascal. 5 | It takes input grammars in extended Backus–Naur Form and produces a Unicode capable lexer and a recursive descent parser that automatically constructs an abstract sintax tree. 6 | 7 | Motivation 8 | ---------------- 9 | When I decided to start this project I was writing a Object Pascal parser using Yacc and Lex. 10 | Why was it necessary to spend so much time writing boiler-plate code and manually assembling a AST, I asked. 11 | 12 | Could it be possible to generate a complete parser just from a grammar description? 13 | 14 | The answer is yes, as long as we're ok with cutting some corners. 15 | 16 | How it works 17 | ---------------- 18 | Paspargen requires just a single grammar file as input. 19 | 20 | A grammar file is just composed of a big list of rules, and Paspargen automatically deduces what rules should be handled to the lexer, and what should be handled by the parser. 21 | 22 | Rules are turned into nodes of a abstract sintax tree and checked for redundancy and circular references. 23 | 24 | Node types supported 25 | * Literals/Keywords 26 | * Regular expressions 27 | * Class hierarchies 28 | 29 | Warning 30 | ---------------- 31 | The current code is a mess, this was a experiment done in a week. Will be cleaned later, if I have the time. 32 | However is already in a functional state, capable of generating parsers for complex languages. -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /Source/paspargen.dpr: -------------------------------------------------------------------------------- 1 | {how to support ambiguities... 2 | let multiple tokens reside at same place, as long as they have the same value/length! 3 | 4 | ? BinaryOperator 5 | 6 | WhileStatement, ForStatement, RepeatStatement, 7 | 8 | 9 | Possible improvement -> for lookead parsing (eg:binary expression), generate shorted parseBinaryExpr() method 10 | 11 | Possible improvement -> turn simple regex (eg: "true") into string matchers 12 | } 13 | 14 | Program paspargen; 15 | 16 | {$APPTYPE CONSOLE} 17 | 18 | Uses TERRA_Utils, TERRA_String, TERRA_Stream, TERRA_MemoryStream, TERRA_FileStream, TERRA_Error, 19 | TERRA_Lexer, TERRA_Parser 20 | ; 21 | 22 | (* 23 | 24 | Block = 'begin' Statement 'end' ';'; 25 | Declarations = Consts, Vars, Types, Labels; 26 | 27 | Statement = StatementList, WhileStatement, ForStatement, RepeatStatement, Assignment; 28 | 29 | WhileStatement = 'while' Condition 'do' Statement; 30 | RepeatStatement = 'repeat' Statement 'until' Condition ';'; 31 | Assignment = Variable ':=' Expression ';'; 32 | 33 | Comment = BeginComment -> { } -> EndComment; 34 | Define = '{$IFDEF' Identifier '}' -> { } -> '{$ENDIF}'; 35 | 36 | *) 37 | { 38 | 39 | http://en.wikipedia.org/wiki/LALR_parser 40 | http://wiki.freepascal.org/Regexpr 41 | 42 | http://stackoverflow.com/questions/9814528/recursive-descent-parser-implementation 43 | 44 | http://www.tutorialspoint.com/compiler_design/compiler_design_bottom_up_parser.htm 45 | 46 | 47 | possible cases 48 | 49 | Abstract class with children or Logical rule (meaning no class is generated) 50 | Goal = Program, Unit; 51 | 52 | Value (RegExpr) -> Those will be parsed and returned as a string 53 | IntegerNumber = "[0-9]+"; 54 | 55 | 56 | AST NODE 57 | Program = 'program' Identifier ';' [UsesDecl] [Declarations] Block '.'; 58 | generates 59 | ProgramNode = Class(GoalNode) 60 | Protected 61 | _Identifier:IdentifierNode; 62 | _UsesDecl:_UsesDeclNode; 63 | _Declarations:DeclarationsNode; 64 | etc 65 | End; 66 | 67 | 68 | parser algoritm 69 | 1 - start with goal 70 | 2 - goal tries matching any of his rules 71 | 3 - found rule tries to parse any of its rules 72 | 4 - etc etc repeat recursively 73 | 74 | LEXER algoritm 75 | 76 | possibilties:array of string -> contains all regexpr and normal tokens, sorted by length/frequency 77 | 1 - get next char 78 | 2 - test match for each possibility_value 79 | 3 - those that failed get discarded 80 | (just send them to the end of the list) 81 | 4 - check if any match is complete, if yes, generate a new token 82 | 5 - if all matches failed, generate error 83 | 6 - else, return to step 1 84 | 85 | Note: this has to respect precedence, and should find the longest token!!! 86 | 87 | 88 | AST := Parser.ParseGoal(); 89 | 90 | Parser.ParseGoal(); Begin Result := Parser.ParseProgram(); End; 91 | 92 | Parser.ParseProgram(); 93 | Begin 94 | ExpectToken('program'); 95 | Self.Identifier := ExpectNode(Self.ParseIdentifier()); 96 | ExpectToken(';'); 97 | Self.UsesDecl := OptionalNode(Self.ParseUsesDecl()); 98 | Self.Declarations := OptionalNode(Self.ParseDeclarations()); 99 | Selfe.Block := ExpectNode(Self.ParseBlock()); 100 | ExpectToken('.'); 101 | 102 | Result := ProgramNode.Create(Identifier, UsesDecl, Declarations, Block); 103 | End; 104 | 105 | } 106 | 107 | 108 | Type 109 | GrammarRuleKind = (rule_Unknown, rule_abstract, rule_compound, rule_set, rule_token, rule_RegExpr); 110 | 111 | GrammarEntryKind = (grammar_Token, grammar_RegExpr, grammar_Rule); 112 | 113 | Grammar = Class; 114 | GrammarToken = Class; 115 | 116 | GrammarEntry = Record 117 | Kind:GrammarEntryKind; 118 | Value:TERRAString; 119 | Annotation:TERRAString; 120 | OptionalID:Integer; 121 | Null:Boolean; 122 | ListID:Integer; 123 | Token:GrammarToken; 124 | Discard:Boolean; 125 | CustomType:TERRAString; 126 | 127 | GenType:TERRAString; 128 | IsLookAhead:Boolean; 129 | IsImportant:Boolean; 130 | End; 131 | 132 | GrammarRuleLine = Class 133 | EntryList:Array Of GrammarEntry; 134 | EntryCount:Integer; 135 | 136 | Procedure AddEntry(Const S:TERRAString; Kind:GrammarEntryKind; OptionalID:Integer); 137 | 138 | Function GetKind():GrammarRuleKind; 139 | End; 140 | 141 | GrammarRule = Class 142 | Public 143 | Name:TERRAString; 144 | 145 | Lines:Array Of GrammarRuleLine; 146 | LineCount:Integer; 147 | 148 | CurrentLine:GrammarRuleLine; 149 | 150 | Procedure NewLine(); 151 | 152 | Function GetKind():GrammarRuleKind; 153 | End; 154 | 155 | {GrammarSet = Class 156 | Owner:Grammar; 157 | Name:TERRAString; 158 | 159 | Values:Array Of TERRAString; 160 | ValueCount:Integer; 161 | 162 | Constructor Create(Const Name: TERRAString; Owner:Grammar); 163 | Procedure AddValue(Const S, Annotation:TERRAString); 164 | End;} 165 | 166 | GrammarNode = Class; 167 | 168 | GrammarField = Record 169 | Name:TERRAString; 170 | Entry:GrammarEntry; 171 | Node:GrammarNode; 172 | End; 173 | 174 | GrammarToken = Class 175 | ID:Cardinal; 176 | Name:TERRAString; 177 | Value:TERRAString; 178 | RegExpr:Boolean; 179 | Discard:Boolean; 180 | 181 | Procedure GenerateRegExp(Dest:Stream); 182 | Procedure GenerateStringMatch(Dest:Stream); 183 | End; 184 | 185 | 186 | GrammarNode = Class 187 | Index:Integer; 188 | 189 | Owner:Grammar; 190 | Name:TERRAString; 191 | Parent:GrammarNode; 192 | 193 | Declared:Boolean; 194 | ArrayDeclared:Boolean; 195 | 196 | LookAheadIndex:Integer; 197 | ImportantIndex:Integer; 198 | 199 | Fields:Array Of GrammarField; 200 | FieldCount:Integer; 201 | 202 | Children:Array Of GrammarNode; 203 | ChildrenCount:Integer; 204 | ExpectedChildrenCount:Integer; 205 | ExpectedChildren:Array Of TERRAString; 206 | 207 | Constructor Create(Index:Integer; Const Name: TERRAString; Owner: Grammar); 208 | Procedure AddField(Const Entry:GrammarEntry); 209 | 210 | Function UseNode(Node:GrammarNode):Boolean; 211 | 212 | Function GenNextToken(Const OptValue:TERRAString; Const Token:GrammarToken):TERRAString; 213 | 214 | Function GenArgs():TERRAString; 215 | Function GenParseNode(Const Store, NodeKind, IsOpt:TERRAString):TERRAString; 216 | 217 | Procedure GenLookAhead(From:GrammarNode; Dest:Stream; Tabs:TERRAString); 218 | 219 | Procedure GenCompoundNode(Dest:Stream; AllowOpt:Boolean; Const IsOpt:TERRAString); 220 | Procedure GenAbstractNode(Dest:Stream; AllowOpt:Boolean; Const IsOpt:TERRAString); 221 | End; 222 | 223 | Grammar = Class 224 | Protected 225 | Name:TERRAString; 226 | 227 | Rules:Array Of GrammarRule; 228 | RuleCount:Integer; 229 | 230 | Tokens:Array Of GrammarToken; 231 | TokenCount:Integer; 232 | LastTokenID:Cardinal; 233 | TokenNames:Array Of TERRAString; 234 | 235 | Nodes:Array Of GrammarNode; 236 | NodeCount:Integer; 237 | 238 | { Sets:Array Of GrammarSet; 239 | SetCount:Integer;} 240 | 241 | Function GetParent(Const Value:TERRAString):GrammarNode; 242 | Function GetNode(Const Value:TERRAString):GrammarNode; 243 | Function HasNode(Const Value:TERRAString):Boolean; 244 | Function GetToken(Value, Name:TERRAString; ID:Integer; RegExpr, Discard:Boolean):GrammarToken; 245 | 246 | { Function GetSet(Const Value:TERRAString):GrammarSet; 247 | Function FindSet(Const Value:TERRAString):GrammarSet;} 248 | 249 | Function OrderNode(Index:Integer):Boolean; 250 | 251 | Function AllocToken(Const Name:TERRAString):Cardinal; 252 | 253 | Public 254 | Constructor Create(S:TERRAString); 255 | 256 | Function ProcessRules():Boolean; 257 | 258 | Procedure GenerateNodesInterface(Dest:Stream); 259 | Procedure GenerateNodesImplementation(Dest:Stream); 260 | 261 | Procedure GenerateTokenInterface(Dest:Stream); 262 | Procedure GenerateTokenImplementation(Dest:Stream); 263 | 264 | Procedure GenerateLexerInterface(Dest:Stream); 265 | Procedure GenerateLexerImplementation(Dest:Stream); 266 | 267 | Procedure GenerateParserInterface(Dest:Stream); 268 | Procedure GenerateParserImplementation(Dest:Stream); 269 | 270 | Procedure GenerateVisitorInterface(Dest:Stream); 271 | Procedure GenerateVisitorImplementation(Dest:Stream); 272 | 273 | { Procedure GeneratePreProcessorInterface(Dest:Stream); 274 | Procedure GeneratePreProcessorImplementation(Dest:Stream);} 275 | 276 | Procedure Generate(Dest:Stream); 277 | End; 278 | 279 | Var 280 | Code, PrevCode:TERRAString; 281 | PrevLine:Integer; 282 | LineNumber:Integer; 283 | LastChar:TERRAChar; 284 | 285 | Function NextToken():TERRAString; 286 | Var 287 | It:StringIterator; 288 | Temp:TERRAString; 289 | C, Inside:TERRAChar; 290 | Ignore, SkipChar:Boolean; 291 | Begin 292 | PrevCode := Code; 293 | PrevLine := LineNumber; 294 | 295 | Inside := 0; 296 | Ignore := False; 297 | C := 0; 298 | 299 | StringCreateIterator(Code, It); 300 | Result := ''; 301 | SkipChar := False; 302 | While It.HasNext() Do 303 | Begin 304 | C := It.GetNext(); 305 | 306 | If (Ignore) Then 307 | Begin 308 | //If (C=Ord('}')) Then Ignore := False; 309 | 310 | Continue; 311 | End; 312 | 313 | If C = NewLineChar Then 314 | Inc(LineNumber); 315 | 316 | If (C=Ord('/')) And (LastChar=C) Then 317 | Begin 318 | While (It.HasNext()) And (C<>NewLineChar) Do 319 | Begin 320 | C := It.GetNext(); 321 | End; 322 | Inc(LineNumber); 323 | End; 324 | 325 | If (C=Ord('\')) And (LastChar <> Ord('\')) Then 326 | Begin 327 | C := It.GetNext(); 328 | 329 | Case C Of 330 | Ord('n'): C := NewLineChar; 331 | Ord('t'): C := 9; 332 | End; 333 | 334 | LastChar := C; 335 | StringAppendChar(Result, C); 336 | Continue; 337 | End; 338 | 339 | LastChar := C; 340 | 341 | If (C<=13) Then 342 | Continue; 343 | 344 | If (Inside>0) And (Not SkipChar) Then 345 | Begin 346 | If (C = Inside) Then 347 | Begin 348 | It.Split(Temp, Code); 349 | StringAppendChar(Result, C); 350 | Break; 351 | End Else 352 | StringAppendChar(Result, C); 353 | 354 | Continue; 355 | End; 356 | 357 | If ((C=Ord('"')) Or (C=Ord(''''))) And (Not SkipChar) Then 358 | Begin 359 | Inside := C; 360 | StringAppendChar(Result, C); 361 | Continue; 362 | End; 363 | 364 | {If (C=Ord('(')) And (Not SkipChar) Then 365 | Begin 366 | Inside := Ord(')'); 367 | StringAppendChar(Result, C); 368 | Continue; 369 | End;} 370 | 371 | SkipChar := False; 372 | 373 | {If (C=Ord('{')) Then 374 | Begin 375 | Ignore := True; 376 | Continue; 377 | End;} 378 | 379 | If (CharLower(C)>=Ord('a')) And (CharLower(C)<=Ord('z')) Then 380 | StringAppendChar(Result, C) 381 | Else 382 | If (CharLower(C)>=Ord('0')) And (CharLower(C)<=Ord('9')) Then 383 | StringAppendChar(Result, C) 384 | Else 385 | If (C=Ord('_')) Or (C=Ord('"')) Then 386 | StringAppendChar(Result, C) 387 | Else 388 | If (Result<>'') Or (C>32) Then 389 | Begin 390 | If (Result = '') Then 391 | Begin 392 | It.Split(Result, Code); 393 | Result := StringFromChar(C); 394 | End Else 395 | Begin 396 | It.Split(Temp, Code); 397 | If C > 32 Then 398 | StringPrependChar(Code, C); 399 | End; 400 | 401 | Break; 402 | End; 403 | End; 404 | 405 | Result := StringTrim(Result); 406 | WriteLn(Result); 407 | 408 | If Result = '' Then 409 | RaiseError('unexpected end of file!'); 410 | End; 411 | 412 | Procedure RevertToken(); 413 | Begin 414 | Code := PrevCode; 415 | LineNumber := PrevLine; 416 | End; 417 | 418 | Procedure Expect(Const S:TERRAstring); 419 | Var 420 | Token:TERRAString; 421 | Begin 422 | Token := NextToken(); 423 | If Not StringEquals(S, Token) Then 424 | Begin 425 | RaiseError('Sintax error: expected '+S+' at line '+IntToString(LineNumber)); 426 | End; 427 | End; 428 | 429 | Function ExpectID():TERRAString; 430 | Var 431 | It:StringIterator; 432 | C:TERRAChar; 433 | Begin 434 | Result := NextToken(); 435 | 436 | StringCreateIterator(Result, It); 437 | While It.HasNext() Do 438 | Begin 439 | C := It.GetNext(); 440 | If (C'' Then 466 | Values[Pred(ValueCount)] := Annotation 467 | Else 468 | Values[Pred(ValueCount)] := S; 469 | End;} 470 | 471 | ///////////////////////////////////////////////////////////////////////////////// 472 | 473 | { GrammarToken } 474 | Procedure GrammarToken.GenerateRegExp(Dest: Stream); 475 | Type 476 | RegExState = Record 477 | Condition:TERRAString; 478 | Opt:Integer; 479 | End; 480 | 481 | Var 482 | It, It2:StringIterator; 483 | Temp:StringIteratorState; 484 | C, PC:TERRAChar; 485 | S, S2, Prev, Rest:TERRAString; 486 | Negate:Boolean; 487 | 488 | I, CurrentState, FinalState:Integer; 489 | States:Array Of RegExState; 490 | StateCount:Integer; 491 | Begin 492 | StringCreateIterator(Self.Value, It); 493 | 494 | States := Nil; 495 | StateCount := 0; 496 | 497 | Negate := False; 498 | While It.HasNext Do 499 | Begin 500 | C := It.GetNext(); 501 | S := ''; 502 | 503 | If (C=Ord('[')) Then 504 | Begin 505 | If It.PeekNext() = Ord('^') Then 506 | Begin 507 | Negate := True; 508 | It.GetNext(); 509 | End Else 510 | Negate := False; 511 | 512 | S2 := ''; 513 | While It.HasNext() Do 514 | Begin 515 | C := It.GetNext(); 516 | If C= Ord(']') Then 517 | Break; 518 | 519 | StringAppendChar(S2, C); 520 | End; 521 | 522 | StringCreateIterator(S2, It2); 523 | S := ''; 524 | Prev := ''; 525 | While It2.HasNext() Do 526 | Begin 527 | PC := C; 528 | C := It2.GetNext(); 529 | 530 | If (C = Ord('-')) Then 531 | Begin 532 | S := Prev; 533 | C := It2.GetNext(); 534 | 535 | If (C=0) Then 536 | C := Ord('-'); 537 | 538 | If S<>'' Then 539 | S := S + ' Or '; 540 | S := S + '((C >= ' + CardinalToString(PC)+') And (C <= ' + CardinalToString(C)+'))'; 541 | 542 | Continue; 543 | End; 544 | 545 | Prev := S; 546 | If S<>'' Then 547 | S := S + ' Or '; 548 | S := S + '(C = ' + CardinalToString(C)+')'; 549 | 550 | 551 | End; 552 | 553 | If Negate Then 554 | S := 'Not ('+S+')'; 555 | 556 | S := 'If ' + S + ' Then'; 557 | //_a-zA-Z 558 | End Else 559 | Begin 560 | S := S + '(C = ' + CardinalToString(C)+')'; 561 | S := 'If ' + S + ' Then'; 562 | End; 563 | 564 | Inc(StateCount); 565 | SetLength(States, StateCount); 566 | 567 | States[Pred(StateCount)].Condition := S; 568 | 569 | It.SaveState(Temp); 570 | C := It.GetNext(); 571 | If (C=Ord('*')) Then 572 | Begin 573 | States[Pred(StateCount)].Opt := -1; 574 | End Else 575 | If (C=Ord('?')) Then 576 | Begin 577 | States[Pred(StateCount)].Opt := 1; 578 | End Else 579 | If (C=Ord('+')) Then 580 | Begin 581 | States[Pred(StateCount)].Opt := 2; 582 | End Else 583 | Begin 584 | States[Pred(StateCount)].Opt := 0; 585 | It.RestoreState(Temp); 586 | End; 587 | 588 | Negate := False; 589 | End; 590 | 591 | CurrentState := 0; 592 | FinalState := Pred(StateCount); 593 | For I:=0 To Pred(StateCount) Do 594 | If (States[I].Opt=0) Or (States[I].Opt=2) Then 595 | Begin 596 | FinalState := I; 597 | End; 598 | 599 | Dest.WriteLine(#9+'Case _State Of'); 600 | For I:=0 To Pred(StateCount) Do 601 | Begin 602 | Dest.WriteLine(#9#9+IntToString(CurrentState)+':'); 603 | 604 | {If (Opt<0) And (Not It.HasNext()) Then // optimization for * in last position 605 | Begin 606 | Dest.WriteLine(#9#9#9+'Begin'); 607 | Dest.WriteLine(#9#9#9#9+'Result := True;'); 608 | Dest.WriteLine(#9#9#9+'End;'); 609 | Break; 610 | End;} 611 | 612 | Dest.WriteLine(#9#9#9+States[I].Condition); 613 | Dest.WriteLine(#9#9#9+'Begin'); 614 | If I = FinalState Then 615 | Dest.WriteLine(#9#9#9+'_Complete := True;'); 616 | Dest.WriteLine(#9#9#9#9+'Result := True;'); 617 | 618 | If (States[I].Opt>=0) Then 619 | Dest.WriteLine(#9#9#9#9+'Inc(_State);'); 620 | 621 | Dest.WriteLine(#9#9#9+'End Else'); 622 | 623 | If (States[I].Opt = 2) Then // + -> 1 or more reps 624 | Begin 625 | Dest.WriteLine(#9#9#9+'Begin'); 626 | Dest.WriteLine(#9#9#9#9+'Result := False;'); 627 | Dest.WriteLine(#9#9#9+'End;'); 628 | 629 | Inc(CurrentState); 630 | Dest.WriteLine(#9#9+IntToString(CurrentState)+':'); 631 | Dest.WriteLine(#9#9#9+S); 632 | Dest.WriteLine(#9#9#9+'Begin'); 633 | If I = FinalState Then 634 | Dest.WriteLine(#9#9#9+'_Complete := True;'); 635 | Dest.WriteLine(#9#9#9#9+'Result := True;'); 636 | Dest.WriteLine(#9#9#9+'End Else'); 637 | End; 638 | 639 | If (States[I].Opt<>0) Then 640 | Begin 641 | Dest.WriteLine(#9#9#9+'Begin'); 642 | Dest.WriteLine(#9#9#9#9+'Inc(_State);'); 643 | Dest.WriteLine(#9#9#9#9+'Result := Self.Match(C);'); 644 | Dest.WriteLine(#9#9#9+'End;'); 645 | End Else 646 | Dest.WriteLine(#9#9#9#9+'Result := False;'); 647 | 648 | Dest.WriteLine(); 649 | 650 | Inc(CurrentState); 651 | End; 652 | 653 | Dest.WriteLine(#9#9+'Else'); 654 | // Dest.WriteLine(#9#9+'Begin'); 655 | // Dest.WriteLine(#9#9#9+'_Complete := (_State >= '+IntToString(Pred(State))+');'); 656 | Dest.WriteLine(#9#9#9+'Result := False;'); 657 | // Dest.WriteLine(#9#9+'End;'); 658 | Dest.WriteLine(#9+'End;'); 659 | End; 660 | 661 | Procedure GrammarToken.GenerateStringMatch(Dest: Stream); 662 | Var 663 | It:StringIterator; 664 | C:TERRAChar; 665 | S:TERRAString; 666 | Begin 667 | If (StringLength(Self.Value)=1) Then 668 | Begin 669 | C := StringFirstChar(Self.Value); 670 | S := ' // '+Self.Value; 671 | Dest.WriteLine(#9+'If (C = '+CardinalToString(C)+') Then'+S); 672 | Dest.WriteLine(#9#9+'Result := tokenAccept'); 673 | Dest.WriteLine(#9+'Else'); 674 | Dest.WriteLine(#9#9+'Result := tokenReject;'); 675 | End; 676 | 677 | {Dest.WriteLine(#9+'Case _Index Of'); 678 | StringCreateIterator(Self.Value, It); 679 | While It.HasNext Do 680 | Begin 681 | C := It.GetNext(); 682 | 683 | Dest.WriteLine(#9+IntToString(It.Position)+':'); 684 | Dest.WriteLine(#9#9+'If (C = '+CardinalToString(C)+') Then'); 685 | Dest.WriteLine(#9#9#9+'Result := tokenIncomplete'); 686 | Dest.WriteLine(#9#9+'Else'); 687 | Dest.WriteLine(#9#9#9+'Result := tokenReject;'); 688 | Dest.WriteLine(); 689 | End; 690 | Dest.WriteLine(#9+'Else'); 691 | Dest.WriteLine(#9#9+'Result := tokenReject;'); 692 | Dest.WriteLine(#9+'End;');} 693 | End; 694 | 695 | { GrammarNode } 696 | Constructor GrammarNode.Create(Index:Integer; Const Name: TERRAString; Owner: Grammar); 697 | Begin 698 | Self.Index := Index; 699 | Self.Name := Name; 700 | Self.Owner := Owner; 701 | Self.Parent := Nil; 702 | Self.LookAheadIndex := -1; 703 | Self.ImportantIndex := -1; 704 | end; 705 | 706 | Procedure GrammarNode.AddField(Const Entry:GrammarEntry); 707 | Var 708 | Node:GrammarNode; 709 | Begin 710 | If Entry.Kind = grammar_Rule Then 711 | Begin 712 | Node := Self.Owner.GetNode(Entry.Value); 713 | End Else 714 | Node := Nil; 715 | 716 | Inc(FieldCount); 717 | SetLength(Fields, FieldCount); 718 | Fields[Pred(FieldCount)].Node := Node; 719 | Fields[Pred(FieldCount)].Entry := Entry; 720 | 721 | If Entry.Annotation <>'' Then 722 | Fields[Pred(FieldCount)].Name := Entry.Annotation 723 | Else 724 | Fields[Pred(FieldCount)].Name := Entry.Value; 725 | End; 726 | 727 | Function GrammarNode.UseNode(Node: GrammarNode): Boolean; 728 | Var 729 | I:Integer; 730 | Begin 731 | Result := True; 732 | 733 | If (Parent = Node) Then 734 | Exit; 735 | 736 | For I:=0 To Pred(FieldCount) do 737 | If (Fields[I].Node = Node) Then 738 | Exit; 739 | 740 | Result := False; 741 | End; 742 | 743 | Procedure GrammarNode.GenLookAhead(From:GrammarNode; Dest: Stream; Tabs:TERRAString); 744 | Var 745 | I:Integer; 746 | Field:GrammarField; 747 | LookAhead:TERRAString; 748 | Begin 749 | LookAhead := Self.Fields[Self.LookAheadIndex].Name; 750 | 751 | Dest.WriteLine(Tabs+'LookAheadToken := Self.CurrentToken;'); 752 | Dest.WriteLine(Tabs+ Self.GenParseNode(LookAhead, LookAhead, 'True')); 753 | Dest.WriteLine(Tabs+'If '+ LookAhead+' = Nil Then'); 754 | Dest.WriteLine(Tabs+'Begin'); 755 | Dest.WriteLine(Tabs+#9+'Self.CurrentToken := LookAheadToken;'); 756 | Dest.WriteLine(Tabs+#9+'Exit;'); 757 | Dest.WriteLine(Tabs+'End;'); 758 | 759 | For I:=Succ(LookAheadIndex) To Pred(From.ChildrenCount) Do 760 | Begin 761 | Field := Self.Fields[I]; 762 | 763 | Dest.WriteLine(Tabs+ Self.GenParseNode(Field.Name, Field.Node.Name, 'True')); 764 | Dest.WriteLine(Tabs+'If Assigned('+ Field.Name+') Then'); 765 | Dest.WriteLine(Tabs+'Begin'); 766 | Dest.WriteLine(#9+Tabs+'Result := '+Self.Name+'Node.Create(Result, '+LookAhead + ', '+Field.Name+');'); 767 | Dest.WriteLine(#9+Tabs+'Exit;'); 768 | Dest.WriteLine(Tabs+'End;'); 769 | Break; 770 | End; 771 | End; 772 | 773 | Function GrammarNode.GenNextToken(const OptValue: TERRAString; Const Token:GrammarToken): TERRAString; 774 | Begin 775 | Result := 'If (Not NextToken().ExpectToken(HandlerNode, '+OptValue+', '+CardinalToString(Token.ID)+')) Then'; 776 | End; 777 | 778 | 779 | Function GrammarNode.GenParseNode(const Store, NodeKind, IsOpt: TERRAString): TERRAString; 780 | Var 781 | Handler:TERRAString; 782 | Begin 783 | If Self.Index = 0 Then 784 | Handler := Self.Name+'Node' 785 | Else 786 | Handler := 'HandlerNode'; 787 | 788 | Result := Store + ' := Self.Parse'+NodeKind+'('+Handler+', '+IsOpt+');'; 789 | End; 790 | 791 | Procedure GrammarNode.GenAbstractNode(Dest: Stream; AllowOpt:Boolean; Const IsOpt:TERRAString); 792 | Var 793 | OptValue, NodeName, S, S2:TERRAString; 794 | J, K:Integer; 795 | Temp, LookAhead:GrammarNode; 796 | Begin 797 | Dest.WriteLine('Var'); 798 | Dest.WriteLine(#9+'TempToken:LexerToken;'); 799 | 800 | For J:=0 To Pred(Self.ChildrenCount) Do 801 | Begin 802 | If (Self.ExpectedChildrenCount>0) Then 803 | NodeName := Self.ExpectedChildren[J] 804 | Else 805 | NodeName := Self.Children[J].Name; 806 | 807 | Temp := Self.Owner.GetNode(NodeName); 808 | If Temp.LookAheadIndex>=0 Then 809 | Begin 810 | Dest.WriteLine(#9+'LookAheadToken:LexerToken;'); 811 | 812 | For K:=Temp.LookAheadIndex To Pred(Temp.FieldCount) Do 813 | Dest.WriteLine(#9+Temp.Fields[K].Name+':'+Temp.Fields[K].Entry.Value+'Node;'); 814 | 815 | Break; 816 | End; 817 | End; 818 | 819 | Dest.WriteLine('Begin'); 820 | 821 | If (Self.ChildrenCount'' Then 831 | S := S + ', '; 832 | S := S + Self.ExpectedChildren[J]; 833 | End Else 834 | Begin 835 | Temp := Self.Owner.GetNode(Self.ExpectedChildren[J]); 836 | If Temp.Parent <> Self Then 837 | Begin 838 | If S2<>'' Then 839 | S2 := S2 + ', '; 840 | S2 := S2 + Self.ExpectedChildren[J]; 841 | End; 842 | End; 843 | 844 | If S2<>'' Then 845 | RaiseError('Invalid node: '+Self.Name+', '+IntToString(K)+' subnodes have multiple parents ('+S2+')') 846 | Else 847 | If S<>'' Then 848 | RaiseError('Incomplete node: '+Self.Name+', '+IntToString(K)+' subnodes are missing declarations ('+S+')'); 849 | End Else 850 | If (Self.ChildrenCount<=0) Then 851 | Begin 852 | RaiseError('Undefined terminal node: '+Self.Name); 853 | End; 854 | 855 | LookAhead := Nil; 856 | 857 | S := ''; 858 | For J:=0 To Pred(Self.ChildrenCount) Do 859 | Begin 860 | If (J0) Then 866 | NodeName := Self.ExpectedChildren[J] 867 | Else 868 | NodeName := Self.Children[J].Name; 869 | 870 | Temp := Self.Owner.GetNode(NodeName); 871 | If Temp.LookAheadIndex>=0 Then 872 | Begin 873 | LookAhead := Temp; 874 | Continue; 875 | End; 876 | 877 | Dest.WriteLine(#9+'TempToken := Self.CurrentToken;'); 878 | Dest.WriteLine(#9+Self.GenParseNode('Result', NodeName, OptValue)); 879 | 880 | If J'' Then 899 | S := S + '/'; 900 | S := S + NodeName; 901 | End; 902 | 903 | If AllowOpt Then 904 | Dest.WriteLine(#9'If (Result = Nil) And (Not IsOpt) Then') 905 | Else 906 | Dest.WriteLine(#9'If (Result = Nil) Then'); 907 | 908 | Dest.WriteLine(#9#9'ParsingExceptedError('+Self.Name+'Node, '''+{S+}''');'); 909 | 910 | If Assigned(LookAhead) Then 911 | Begin 912 | LookAhead.GenLookAhead(Self, Dest, #9); 913 | End; 914 | 915 | If Self.ChildrenCount<=0 Then 916 | Dest.WriteLine(#9'Result := Nil;'); 917 | End; 918 | 919 | Procedure GrammarNode.GenCompoundNode(Dest: Stream; AllowOpt:Boolean; Const IsOpt:TERRAString); 920 | Var 921 | J, K:Integer; 922 | S, CustomType, Conversion, OptValue, NodeKind, NodeName:TERRAString; 923 | HasLabels, FoundToken:Boolean; 924 | Begin 925 | HasLabels := False; 926 | 927 | { If Self.Name = 'TypeAlias' Then 928 | IntToString(2);} 929 | 930 | For J:=0 To Pred(Self.FieldCount) Do 931 | Begin 932 | If (Self.Fields[J].Entry.Kind <> grammar_Token) Or (Self.Fields[J].Entry.GenType<>'') Then 933 | Begin 934 | Dest.WriteLine('Var'); 935 | Break; 936 | End; 937 | End; 938 | 939 | HasLabels := False; 940 | 941 | For J:=0 To Pred(Self.FieldCount) Do 942 | Begin 943 | If (Self.Fields[J].Entry.OptionalID>0) Or (Self.Fields[J].Entry.ListID>0) Then 944 | HasLabels := True; 945 | 946 | NodeName := Self.Fields[J].Name; 947 | 948 | Case Self.Fields[J].Entry.Kind Of 949 | grammar_Token: 950 | If (Self.Fields[J].Entry.GenType<>'') Then 951 | Begin 952 | NodeName := Self.Fields[J].Entry.Annotation; 953 | NodeKind := Self.Fields[J].Entry.GenType; 954 | End Else 955 | Continue; 956 | 957 | grammar_Rule: 958 | Begin 959 | NodeKind := Self.Fields[J].Node.Name+'Node'; 960 | 961 | If Self.Fields[J].Entry.ListID>0 Then 962 | Dest.WriteLine(#9+Self.Fields[J].Node.Name+'s :'+NodeKind+'Array;'); 963 | End; 964 | 965 | grammar_RegExpr: 966 | Begin 967 | If Self.Fields[J].Entry.CustomType<>'' Then 968 | NodeKind := Self.Fields[J].Entry.CustomType 969 | Else 970 | NodeKind := 'TERRAString'; 971 | End; 972 | End; 973 | 974 | Dest.WriteLine(#9+NodeName+' :'+NodeKind+';'); 975 | End; 976 | 977 | If HasLabels Then 978 | Begin 979 | Dest.WriteLine(#9+'TempToken:LexerToken;'); 980 | 981 | For J:=0 To Pred(Self.FieldCount) Do 982 | If (Self.Fields[J].Entry.ListID>0 )Then 983 | Begin 984 | Dest.WriteLine(#9+'ListFinished:Boolean;'); 985 | Break; 986 | End; 987 | 988 | {S := ''; 989 | For J:=0 To Pred(Self.FieldCount) Do 990 | If (Self.Fields[J].Entry.OptionalID>0 ) And (Not Self.Fields[J].Entry.List )Then 991 | Begin 992 | If Self.Fields[J].Entry.Kind = grammar_Token Then 993 | Continue; 994 | 995 | If S<>'' Then 996 | S := S + ','; 997 | S := S + 'EndOpt'+IntToString(Self.Fields[J].Entry.OptionalID); 998 | End; 999 | If S<>'' Then 1000 | Dest.WriteLine('Label '+S+';');} 1001 | End; 1002 | 1003 | Dest.WriteLine('Begin'); 1004 | //Dest.WriteLine('WriteLn(''Parsing '+Self.Name+' '');'); 1005 | 1006 | FoundToken := False; 1007 | Dest.WriteLine(#9'Result := Nil;'); 1008 | 1009 | S := ''; 1010 | For J:=0 To Pred(Self.FieldCount) Do 1011 | Begin 1012 | Case Self.Fields[J].Entry.Kind Of 1013 | grammar_Rule: NodeKind := 'Node'; 1014 | grammar_Token: NodeKind := 'Token'; 1015 | grammar_RegExpr: NodeKind := 'Token'; 1016 | End; 1017 | 1018 | If (J>0) And (Self.Fields[Pred(J)].Entry.OptionalID>0) And (Self.Fields[Pred(J)].Entry.OptionalID<>Self.Fields[J].Entry.OptionalID) 1019 | And (Self.Fields[Pred(J)].Entry.ListID<=0) Then 1020 | Begin 1021 | Dest.WriteLine(#9+'Until True;'); 1022 | Dest.WriteLine(); 1023 | //Dest.WriteLine(#9+'EndOpt'+IntToString(Self.Fields[Pred(J)].Entry.OptionalID)+':'); 1024 | End; 1025 | 1026 | If (Self.Fields[J].Entry.ListID>0) And ((J=0) Or (Self.Fields[Pred(J)].Entry.ListID<=0)) Then 1027 | Begin 1028 | Dest.WriteLine(#9+'TempToken := Self.CurrentToken;'); 1029 | Dest.WriteLine(#9+'ListFinished := False;'); 1030 | Dest.WriteLine(#9+'Repeat'); 1031 | End Else 1032 | If (J>0) And (Self.Fields[J].Entry.OptionalID>0) And (Self.Fields[Pred(J)].Entry.OptionalID<>Self.Fields[J].Entry.OptionalID) Then 1033 | Begin 1034 | Dest.WriteLine(#9+'TempToken := Self.CurrentToken;'); 1035 | Dest.WriteLine(#9+'Repeat'); 1036 | End; 1037 | 1038 | If (Self.Fields[J].Entry.Kind = grammar_Token) Then 1039 | Begin 1040 | If (Self.Fields[J].Entry.ListID>0) Or (Self.Fields[J].Entry.OptionalID>0) Then 1041 | OptValue := 'True' 1042 | Else 1043 | If (FoundToken) Then 1044 | OptValue := 'False' 1045 | Else 1046 | OptValue := 'IsOpt'; 1047 | 1048 | If (Self.Fields[J].Entry.GenType<>'') Then 1049 | Begin 1050 | Dest.WriteLine(#9+Self.Fields[J].Entry.Annotation+' := False;'); 1051 | End; 1052 | 1053 | If Self.Fields[J].Entry.ListID>0 Then 1054 | Begin 1055 | 1056 | Dest.WriteLine(#9+'TempToken := Self.CurrentToken;'); 1057 | Dest.WriteLine(#9+Self.GenNextToken(OptValue, Self.Fields[J].Entry.Token)); 1058 | Dest.WriteLine(#9+'Begin'); 1059 | Dest.WriteLine(#9#9+'Self.CurrentToken := TempToken;'); 1060 | Dest.WriteLine(#9#9+'Break;'); 1061 | Dest.WriteLine(#9+'End;'); 1062 | End Else 1063 | Begin 1064 | Dest.WriteLine(#9+Self.GenNextToken(OptValue, Self.Fields[J].Entry.Token)); 1065 | If (Self.Fields[J].Entry.OptionalID>0) Then 1066 | Begin 1067 | Dest.WriteLine(#9#9+'Begin'); 1068 | For K:=Succ(J) To Pred(Self.FieldCount) Do 1069 | If Assigned(Self.Fields[K].Node) Then 1070 | Dest.WriteLine(#9#9#9+Self.Fields[K].Name +' := Nil;'); 1071 | Dest.WriteLine(#9#9#9+'Self.CurrentToken := TempToken;'); 1072 | Dest.WriteLine(#9#9#9+'Break;'); 1073 | Dest.WriteLine(#9#9+'End;'); 1074 | End Else 1075 | Dest.WriteLine(#9#9#9+'Exit;'); 1076 | End; 1077 | 1078 | If (Self.Fields[J].Entry.GenType<>'') Then 1079 | Begin 1080 | Dest.WriteLine(#9+Self.Fields[J].Entry.Annotation+' := True;'); 1081 | End; 1082 | 1083 | Dest.WriteLine(); 1084 | 1085 | If (Self.Fields[J].Entry.ListID>0) Then 1086 | Begin 1087 | If (J>=Pred(Self.FieldCount)) Or (Self.Fields[Succ(J)].Entry.ListID<=0) Then 1088 | Dest.WriteLine(#9+'Until (ListFinished);'); 1089 | End; 1090 | End Else 1091 | If (Self.Fields[J].Entry.Kind = grammar_Rule) Then 1092 | Begin 1093 | {If Self.Fields[J].Node = Nil Then 1094 | IntToString(2);} 1095 | 1096 | If (Self.Fields[J].Entry.OptionalID>0) Then 1097 | OptValue := 'True' 1098 | Else 1099 | If (Self.Fields[J].Entry.ListID>0) Then 1100 | OptValue := 'True' 1101 | Else 1102 | If FoundToken Then 1103 | OptValue := 'False' 1104 | Else 1105 | OptValue := IsOpt; 1106 | 1107 | If Self.Fields[J].Entry.ListID>0 Then 1108 | Begin 1109 | Dest.WriteLine(#9+Self.GenParseNode(Self.Fields[J].Name, Self.Fields[J].Node.Name, OptValue)); 1110 | Dest.WriteLine(#9+'If Assigned('+Self.Fields[J].Name+') Then'); 1111 | Dest.WriteLine(#9+'Begin'); 1112 | Dest.WriteLine(#9#9+'SetLength('+Self.Fields[J].Name+'s, Succ(Length('+Self.Fields[J].Name+'s)));'); 1113 | Dest.WriteLine(#9#9+Self.Fields[J].Name+'s[Pred(Length('+Self.Fields[J].Name+'s))] := '+Self.Fields[J].Name+';'); 1114 | Dest.WriteLine(#9#9+'TempToken := Self.CurrentToken;'); 1115 | Dest.WriteLine(#9+'End Else'); 1116 | Dest.WriteLine(#9+'Begin'); 1117 | Dest.WriteLine(#9#9+'ListFinished := True;'); 1118 | Dest.WriteLine(#9#9+'Self.CurrentToken := TempToken;'); 1119 | Dest.WriteLine(#9+'End;'); 1120 | 1121 | 1122 | If (J>=Pred(Self.FieldCount)) Or (Self.Fields[Succ(J)].Entry.ListID<=0) Then 1123 | Dest.WriteLine(#9+'Until (ListFinished);'); 1124 | End Else 1125 | Begin 1126 | If Self.Fields[J].Entry.Kind = grammar_Rule Then 1127 | NodeName := Self.Fields[J].Node.Name 1128 | Else 1129 | NodeName := Self.Fields[J].Name; 1130 | 1131 | If (Self.Fields[J].Entry.Null) Then 1132 | Begin 1133 | Dest.WriteLine(#9+'If (Parse'+NodeName+'('+OptValue+')= Nil) Then'); 1134 | End Else 1135 | Begin 1136 | Dest.WriteLine(#9+Self.GenParseNode(Self.Fields[J].Name, NodeName, OptValue)); 1137 | Dest.WriteLine(#9+'If '+Self.Fields[J].Name+'= Nil Then'); 1138 | End; 1139 | 1140 | If Self.Fields[J].Entry.OptionalID>0 Then 1141 | Begin 1142 | Dest.WriteLine(#9+'Begin'); 1143 | Dest.WriteLine(#9#9+'Self.CurrentToken := TempToken;'); 1144 | //Dest.WriteLine(#9#9+'Goto EndOpt'+IntToString(Self.Fields[J].Entry.OptionalID)+';'); 1145 | Dest.WriteLine(#9#9+'Break;'); 1146 | Dest.WriteLine(#9+'End;'); 1147 | End Else 1148 | Dest.WriteLine(#9#9+'Exit;'); 1149 | End; 1150 | 1151 | Dest.WriteLine(); 1152 | End Else 1153 | If (Self.Fields[J].Entry.Kind = grammar_RegExpr) Then 1154 | Begin 1155 | {If Self.Fields[J].Node = Nil Then 1156 | IntToString(2);} 1157 | 1158 | Dest.WriteLine(#9+ Self.GenNextToken('IsOpt', Self.Fields[J].Entry.Token)); 1159 | Dest.WriteLine(#9#9+'Exit;'); 1160 | 1161 | CustomType := Self.Fields[J].Entry.CustomType; 1162 | If (StringEquals(CustomType, 'Double')) Or (StringEquals(CustomType, 'Single'))Then 1163 | Conversion := 'StringToFloat' 1164 | Else 1165 | If StringEquals(CustomType, 'Boolean') Then 1166 | Conversion := 'StringToBool' 1167 | Else 1168 | If StringEquals(CustomType, 'Cardinal') Then 1169 | Conversion := 'StringToCardinal' 1170 | Else 1171 | If StringEquals(CustomType, 'Integer') Then 1172 | Conversion := 'StringToInt' 1173 | Else 1174 | Conversion := ''; 1175 | 1176 | If (Conversion<>'') Then 1177 | Dest.WriteLine(#9+Self.Fields[J].Name+' := '+Conversion+'(TokenValue());') 1178 | Else 1179 | Dest.WriteLine(#9+Self.Fields[J].Name+' := TokenValue();'); 1180 | End Else 1181 | Continue; 1182 | 1183 | If (Not FoundToken) And ( 1184 | ((J>=Self.ImportantIndex) And (Self.ImportantIndex>=0)) 1185 | Or ((Self.ImportantIndex<0) And (Self.Fields[J].Entry.Kind = grammar_Token))) Then 1186 | Begin 1187 | FoundToken := True; 1188 | 1189 | If (J'' Then 1200 | S := S + ', '; 1201 | 1202 | If (Self.Fields[J].Entry.GenType<>'') Then 1203 | S := S + Self.Fields[J].Entry.Annotation 1204 | Else 1205 | Begin 1206 | S := S + Self.Fields[J].Name; 1207 | If Self.Fields[J].Entry.ListID>0 Then 1208 | S := S + 's'; 1209 | End; 1210 | End; 1211 | 1212 | End; 1213 | 1214 | If (Self.Fields[Pred(Self.FieldCount)].Entry.OptionalID>0) 1215 | And (Self.Fields[Pred(Self.FieldCount)].Entry.ListID<=0) Then 1216 | Begin 1217 | Dest.WriteLine(#9+'Until True;'); 1218 | Dest.WriteLine(); 1219 | //Dest.WriteLine(#9+'EndOpt'+IntToString(Self.Fields[Pred(Self.FieldCount)].Entry.OptionalID)+':'); 1220 | End; 1221 | 1222 | Dest.WriteLine(#9+'Result := '+Self.Name+'Node.Create('+S+');'); 1223 | End; 1224 | 1225 | Function GrammarNode.GenArgs: TERRAString; 1226 | Begin 1227 | Result := 'HandlerNode:ASTNodeClass; IsOpt:Boolean'; 1228 | End; 1229 | 1230 | { GrammarRuleLine } 1231 | Procedure GrammarRuleLine.AddEntry(const S: TERRAString; Kind: GrammarEntryKind; OptionalID:Integer); 1232 | Begin 1233 | Inc(EntryCount); 1234 | SetLength(EntryList, EntryCount); 1235 | 1236 | EntryList[Pred(EntryCount)].Kind := Kind; 1237 | EntryList[Pred(EntryCount)].Value := S; 1238 | EntryList[Pred(EntryCount)].OptionalID := OptionalID; 1239 | EntryList[Pred(EntryCount)].Annotation := ''; 1240 | End; 1241 | 1242 | 1243 | Function GrammarRuleLine.GetKind():GrammarRuleKind; 1244 | Var 1245 | I:Integer; 1246 | Begin 1247 | Result := rule_Unknown; 1248 | If Self.EntryCount<=0 Then 1249 | Exit; 1250 | 1251 | If (Self.EntryCount>1) Then 1252 | Begin 1253 | Result := rule_compound; 1254 | Exit; 1255 | End; 1256 | 1257 | Case self.EntryList[0].Kind Of 1258 | grammar_Rule: Result := rule_abstract; 1259 | grammar_RegExpr: Result := rule_RegExpr; 1260 | grammar_Token: Result := rule_Token; 1261 | End; 1262 | End; 1263 | 1264 | { GrammarRule } 1265 | Function GrammarRule.GetKind():GrammarRuleKind; 1266 | Var 1267 | I:Integer; 1268 | Begin 1269 | Result := rule_Unknown; 1270 | 1271 | If Self.LineCount<=0 Then 1272 | Exit; 1273 | 1274 | { If (Self.Preprocessor) Then 1275 | Begin 1276 | Result := rule_Preprocessor; 1277 | Exit; 1278 | End;} 1279 | 1280 | If (Self.LineCount = 1) Then 1281 | Begin 1282 | Result := (self.Lines[0].GetKind()); 1283 | Exit; 1284 | End; 1285 | 1286 | StringToInt(Name, False); 1287 | 1288 | For I:=1 To Pred(Self.LineCount) Do 1289 | If (Lines[I].GetKind() <> Lines[0].GetKind()) Then 1290 | Begin 1291 | Exit; 1292 | End; 1293 | 1294 | If (Lines[0].GetKind() = rule_RegExpr) Then 1295 | Result := rule_RegExpr 1296 | Else 1297 | If (Lines[0].GetKind() = rule_token) Then 1298 | Result := rule_set 1299 | Else 1300 | Result := rule_abstract; 1301 | End; 1302 | 1303 | Procedure GrammarRule.NewLine; 1304 | Begin 1305 | Inc(LineCount); 1306 | SetLength(Lines, LineCount); 1307 | Self.CurrentLine := GrammarRuleLine.Create(); 1308 | Lines[Pred(LineCount)] := Self.CurrentLine; 1309 | End; 1310 | 1311 | { Grammar } 1312 | Constructor Grammar.Create(S:String); 1313 | Var 1314 | Src:Stream; 1315 | Begin 1316 | Src := MemoryStream.Create(S); 1317 | Code := ''; 1318 | While Not Src.EOF Do 1319 | Begin 1320 | Src.ReadLine(S); 1321 | Code := Code + S; 1322 | StringAppendChar(Code, NewLineChar); 1323 | End; 1324 | ReleaseObject(Src); 1325 | 1326 | LineNumber := 1; 1327 | RuleCount := 0; 1328 | Try 1329 | Expect('grammar'); 1330 | Self.Name := ExpectID(); 1331 | Expect(';'); 1332 | 1333 | Expect('rules'); 1334 | While ProcessRules() Do 1335 | Begin 1336 | End; 1337 | 1338 | Except 1339 | Halt; 1340 | End; 1341 | End; 1342 | 1343 | Function Grammar.AllocToken(Const Name:TERRAString): Cardinal; 1344 | Begin 1345 | Result := LastTokenID; 1346 | Inc(LastTokenID); 1347 | SetLength(TokenNames, LastTokenID); 1348 | TokenNames[Result] := Name; 1349 | End; 1350 | 1351 | Function Grammar.GetToken(Value, Name: TERRAString; ID:Integer; RegExpr, Discard:Boolean):GrammarToken; 1352 | Var 1353 | I:Integer; 1354 | Begin 1355 | If (Value<>'') And (Not RegExpr) Then 1356 | For I:=0 To Pred(TokenCount) Do 1357 | If (StringEquals(Tokens[I].Value, Value)) Then 1358 | Begin 1359 | Result := Tokens[I]; 1360 | Exit; 1361 | End; 1362 | 1363 | Inc(TokenCount); 1364 | 1365 | If Name = '' Then 1366 | Name := IntToString(TokenCount); 1367 | 1368 | If ID<0 Then 1369 | ID := Self.AllocToken(Value); 1370 | 1371 | If (RegExpr) Then 1372 | Begin 1373 | If (Not StringContains('[', Value)) And (Not StringContains(']', Value)) Then 1374 | RegExpr := False; 1375 | End; 1376 | 1377 | SetLength(Tokens, TokenCount); 1378 | Result := GrammarToken.Create(); 1379 | Result.ID := ID; 1380 | Result.Value := Value; 1381 | Result.Name := Name; 1382 | Result.RegExpr := RegExpr; 1383 | Result.Discard := Discard; 1384 | Tokens[Pred(TokenCount)] := Result; 1385 | End; 1386 | 1387 | Function Grammar.ProcessRules():Boolean; 1388 | Var 1389 | I ,N, TempLine:Integer; 1390 | S, S2:TERRAString; 1391 | Rule:GrammarRule; 1392 | OptionalID, LastOptionalID:Integer; 1393 | CurrentListID:Integer; 1394 | Begin 1395 | S := NextToken(); 1396 | If (StringEquals(S, 'end')) Then 1397 | Begin 1398 | Expect('.'); 1399 | Result := False; 1400 | Exit; 1401 | End Else 1402 | RevertToken(); 1403 | 1404 | Inc(RuleCount); 1405 | SetLength(Rules, RuleCount); 1406 | 1407 | Rule := GrammarRule.Create(); 1408 | 1409 | Rules[Pred(RuleCount)] := Rule; 1410 | 1411 | Rule.LineCount := 0; 1412 | S := ExpectID(); 1413 | 1414 | For I:=0 To Pred(RuleCount) Do 1415 | If StringEquals(Rules[I].Name, S) Then 1416 | Begin 1417 | RaiseError('Duplicated rule: '+S); 1418 | Exit; 1419 | End; 1420 | 1421 | Rule.Name := S; 1422 | Rule.CurrentLine := Nil; 1423 | 1424 | Expect('='); 1425 | 1426 | OptionalID := 0; 1427 | LastOptionalID := 0; 1428 | CurrentListID := 0; 1429 | TempLine := LineNumber; 1430 | 1431 | Repeat 1432 | S := NextToken(); 1433 | 1434 | If (TempLine<>LineNumber) Then 1435 | RaiseError('Expected ; at line '+ IntToString(TempLine)); 1436 | 1437 | If S = ';' Then 1438 | Break; 1439 | 1440 | If S = '@' Then 1441 | Begin 1442 | S := ExpectID(); 1443 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].Annotation := S; 1444 | Continue; 1445 | End; 1446 | 1447 | If S = '%' Then 1448 | Begin 1449 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].Null := True; 1450 | Continue; 1451 | End; 1452 | 1453 | If S = ',' Then 1454 | Begin 1455 | Rule.NewLine(); 1456 | Continue; 1457 | End; 1458 | 1459 | If S = '=' Then 1460 | Begin 1461 | Expect('>'); 1462 | S := ExpectID(); 1463 | 1464 | If StringEquals(S, 'null') Then 1465 | Begin 1466 | For I:=0 To Pred(Rule.CurrentLine.EntryCount) Do 1467 | Rule.CurrentLine.EntryList[I].Discard := True; 1468 | End Else 1469 | Begin 1470 | For I:=0 To Pred(Rule.CurrentLine.EntryCount) Do 1471 | Rule.CurrentLine.EntryList[I].CustomType := S; 1472 | End; 1473 | 1474 | Expect(';'); 1475 | Break; 1476 | End; 1477 | 1478 | (* If S = '-' Then 1479 | Begin 1480 | Expect('>'); 1481 | Expect('{'); 1482 | Expect('}'); 1483 | Expect(';'); 1484 | Rule.Preprocessor := True; 1485 | Break; 1486 | End;*) 1487 | 1488 | If S = '[' Then 1489 | Begin 1490 | Inc(LastOptionalID); 1491 | OptionalID := LastOptionalID; 1492 | Continue; 1493 | End; 1494 | 1495 | If S = ']' Then 1496 | Begin 1497 | OptionalID := 0; 1498 | Continue; 1499 | End; 1500 | 1501 | If (Rule.CurrentLine = Nil) Then 1502 | Begin 1503 | Rule.NewLine(); 1504 | OptionalID := 0; 1505 | End; 1506 | 1507 | If (StringBeginsWithChar(Ord(':'), S, False)) Then 1508 | Begin 1509 | S := NextToken(); 1510 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].Annotation := S; 1511 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].GenType := 'Boolean'; 1512 | End Else 1513 | If (StringBeginsWithChar(Ord('?'), S, False)) Then 1514 | Begin 1515 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].IsLookAhead := True; 1516 | End Else 1517 | If (StringBeginsWithChar(Ord('!'), S, False)) Then 1518 | Begin 1519 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].IsImportant := True; 1520 | End Else 1521 | If (StringBeginsWithChar(Ord('"'), S, False)) Then 1522 | Begin 1523 | S := StringCopy(S, 2, StringLength(S)- 2); 1524 | Rule.CurrentLine.AddEntry(S, grammar_RegExpr, OptionalID); 1525 | End Else 1526 | If (StringBeginsWithChar(Ord('('), S, False)) Then 1527 | Begin 1528 | Inc(CurrentListID); 1529 | S := NextToken(); 1530 | Rule.CurrentLine.AddEntry(S, grammar_Rule, OptionalID); 1531 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].ListID := CurrentListID; 1532 | 1533 | S := NextToken(); 1534 | If (S <> ')') Then 1535 | Begin 1536 | S := StringCopy(S, 2, StringLength(S)- 2); 1537 | //Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].ListSep := S; 1538 | Rule.CurrentLine.AddEntry(S, grammar_Token, OptionalID); 1539 | Rule.CurrentLine.EntryList[Pred(Rule.CurrentLine.EntryCount)].ListID := CurrentListID; 1540 | Expect(')'); 1541 | End; 1542 | 1543 | End Else 1544 | If (StringBeginsWithChar(Ord(''''), S, False)) Then 1545 | Begin 1546 | S := StringCopy(S, 2, StringLength(S)- 2); 1547 | Rule.CurrentLine.AddEntry(S, grammar_Token, OptionalID); 1548 | End Else 1549 | Begin 1550 | Rule.CurrentLine.AddEntry(S, grammar_Rule, OptionalID); 1551 | End; 1552 | 1553 | Until False; 1554 | 1555 | Result := True; 1556 | End; 1557 | 1558 | Procedure Grammar.GenerateTokenInterface(Dest:Stream); 1559 | Var 1560 | I,J, K:Integer; 1561 | TokenName, S, S2, S3:TERRAString; 1562 | TokenID:Integer; 1563 | Begin 1564 | TokenCount := 0; 1565 | Self.GetToken('', 'Empty', -1, False, False); // null token 1566 | 1567 | For I:=0 To Pred(RuleCount) Do 1568 | Begin 1569 | If (Rules[I].GetKind = rule_RegExpr) Then 1570 | TokenID := Self.AllocToken(Rules[I].Name) 1571 | Else 1572 | TokenID := -1; 1573 | 1574 | For J:=0 To Pred(Rules[I].LineCount) Do 1575 | Begin 1576 | For K:=0 To Pred(Rules[I].Lines[J].EntryCount) Do 1577 | Begin 1578 | TokenName := Rules[I].Lines[J].EntryList[K].Annotation; 1579 | If TokenName = '' Then 1580 | Begin 1581 | TokenName := Rules[I].Name; 1582 | If (Rules[I].LineCount>1) Then 1583 | TokenName := TokenName + IntToString(Succ(J)); 1584 | End; 1585 | 1586 | If (Rules[I].Lines[J].EntryList[K].Kind = grammar_Token) Then 1587 | Begin 1588 | Rules[I].Lines[J].EntryList[K].Token := Self.GetToken(Rules[I].Lines[J].EntryList[K].Value, TokenName, -1, False, Rules[I].Lines[J].EntryList[K].Discard); 1589 | End Else 1590 | If (Rules[I].Lines[J].EntryList[K].Kind = grammar_RegExpr) Then 1591 | Begin 1592 | Rules[I].Lines[J].EntryList[K].Token := Self.GetToken(Rules[I].Lines[J].EntryList[K].Value, TokenName, TokenID, True, Rules[I].Lines[J].EntryList[K].Discard); 1593 | End; 1594 | End; 1595 | End; 1596 | End; 1597 | 1598 | { For I:=0 To Pred(RuleCount) Do 1599 | If (Rules[I].Lines[0].EntryList[0].Kind = grammar_RegExpr) Then 1600 | Begin 1601 | Rules[I].Lines[0].EntryList[0].ID := Self.GetTokenID(Rules[I].Name); 1602 | End;} 1603 | 1604 | For I:=1 To Pred(TokenCount) Do 1605 | If Tokens[I].RegExpr Then 1606 | Begin 1607 | S2 := 'RegexTokenMatcher'; 1608 | 1609 | S := Tokens[I].Name+'RegexMatcher = Class('+S2+')'; 1610 | 1611 | S3 := Tokens[I].Value; 1612 | StringReplaceText(StringFromChar(NewLineChar), '\n', S3); 1613 | StringReplaceText(StringFromChar(9), '\t', S3); 1614 | 1615 | S := S + ' // matcher for ' + S3; 1616 | Dest.WriteLine(#9+S); 1617 | 1618 | S := 'Function Match(Const C:TERRAChar):Boolean; Override;'; 1619 | Dest.WriteLine(#9#9+S); 1620 | 1621 | Dest.WriteLine(#9+'End;'); 1622 | Dest.WriteLine(); 1623 | End; 1624 | 1625 | Dest.WriteLine(); 1626 | End; 1627 | 1628 | 1629 | 1630 | Function Grammar.HasNode(const Value: TERRAString):Boolean; 1631 | Var 1632 | I, J:Integer; 1633 | Begin 1634 | For I:=0 To Pred(NodeCount) Do 1635 | If (StringEquals(Nodes[I].Name, Value)) Then 1636 | Begin 1637 | Result := True; 1638 | Exit; 1639 | End; 1640 | 1641 | Result := False; 1642 | End; 1643 | 1644 | Function Grammar.GetNode(const Value: TERRAString): GrammarNode; 1645 | Var 1646 | I, J:Integer; 1647 | Begin 1648 | For I:=0 To Pred(NodeCount) Do 1649 | If (StringEquals(Nodes[I].Name, Value)) Then 1650 | Begin 1651 | Result := Nodes[I]; 1652 | Exit; 1653 | End; 1654 | 1655 | Inc(NodeCount); 1656 | SetLength(Nodes, NodeCount); 1657 | Result := GrammarNode.Create(Pred(NodeCount), Value, Self); 1658 | Nodes[Pred(NodeCount)] := Result; 1659 | End; 1660 | 1661 | Function Grammar.GetParent(const Value: TERRAString): GrammarNode; 1662 | Var 1663 | I, J, K:Integer; 1664 | Begin 1665 | For I:=0 To Pred(RuleCount) Do 1666 | If (Rules[I].GetKind() = rule_abstract) Then 1667 | Begin 1668 | For J:=0 To Pred(Rules[I].LineCount) Do 1669 | For K:=0 To Pred(Rules[I].Lines[J].EntryCount) Do 1670 | If (StringEquals(Rules[I].Lines[J].EntryList[K].Value, Value)) Then 1671 | Begin 1672 | Result := GetNode(Rules[I].Name); 1673 | Exit; 1674 | End; 1675 | End; 1676 | 1677 | Result := Nil; 1678 | End; 1679 | 1680 | {Function Grammar.FindSet(const Value: TERRAString): GrammarSet; 1681 | Var 1682 | I:Integer; 1683 | Begin 1684 | For I:=0 To Pred(SetCount) Do 1685 | If (StringEquals(Sets[I].Name, Value)) Then 1686 | Begin 1687 | Result := Sets[I]; 1688 | Exit; 1689 | End; 1690 | 1691 | Result := Nil; 1692 | End; 1693 | 1694 | Function Grammar.GetSet(const Value: TERRAString): GrammarSet; 1695 | Var 1696 | I:Integer; 1697 | Begin 1698 | Result := FindSet(Value); 1699 | If Assigned(Result) Then 1700 | Exit; 1701 | 1702 | Inc(SetCount); 1703 | SetLength(Sets, SetCount); 1704 | Result := GrammarSet.Create(Value, Self); 1705 | Sets[Pred(SetCount)] := Result; 1706 | End;} 1707 | 1708 | Function Grammar.OrderNode(Index: Integer):Boolean; 1709 | Var 1710 | I, Min:Integer; 1711 | Temp:GrammarNode; 1712 | Begin 1713 | Min := -1; 1714 | 1715 | For I:=0 To Pred(Index) Do 1716 | If (Nodes[I].UseNode(Nodes[Index])) Then 1717 | Begin 1718 | Min := I; 1719 | Break; 1720 | End; 1721 | 1722 | If Min<0 Then 1723 | Begin 1724 | Result := False; 1725 | Exit; 1726 | End; 1727 | 1728 | 1729 | Temp := Nodes[Index]; 1730 | 1731 | // WriteLn('Moving ',Temp.Name + ' to pos ',Min); 1732 | 1733 | For I:=Index DownTo Succ(Min) Do 1734 | Nodes[I] := Nodes[Pred(I)]; 1735 | 1736 | Nodes[Min] := Temp; 1737 | 1738 | Result := True; 1739 | End; 1740 | 1741 | Procedure Grammar.GenerateNodesInterface(Dest:Stream); 1742 | Var 1743 | I,J, K:Integer; 1744 | S, S2, S3, Prefix, Parent:TERRAString; 1745 | Node, PreNode, Other:GrammarNode; 1746 | HasRegExpr:Boolean; 1747 | // MySet:GrammarSet; 1748 | Begin 1749 | NodeCount := 0; 1750 | 1751 | For I:=0 To Pred(RuleCount) Do 1752 | Begin 1753 | { If Rules[I].Name='BinaryExpression' Then 1754 | IntToString(2);} 1755 | 1756 | Case Rules[I].GetKind() Of 1757 | rule_abstract: 1758 | Begin 1759 | Node := GetNode(Rules[I].Name); 1760 | Node.ExpectedChildrenCount := Rules[I].LineCount; 1761 | 1762 | SetLength(Node.ExpectedChildren, Node.ExpectedChildrenCount); 1763 | K:=0; 1764 | For J:=0 To Pred(Rules[I].LineCount) Do 1765 | Begin 1766 | Node.ExpectedChildren[J] := Rules[I].Lines[J].EntryList[K].Value; 1767 | End; 1768 | End; 1769 | 1770 | rule_RegExpr: 1771 | Begin 1772 | Node := GetNode(Rules[I].Name); 1773 | J:=0; 1774 | For K:=0 To Pred(Rules[I].Lines[J].EntryCount) Do 1775 | Begin 1776 | If Rules[I].Lines[J].EntryList[K].Annotation = '' Then 1777 | Rules[I].Lines[J].EntryList[K].Annotation := 'Value'; 1778 | Node.AddField(Rules[I].Lines[J].EntryList[K]); 1779 | End; 1780 | End; 1781 | 1782 | rule_compound: 1783 | Begin 1784 | Node := GetNode(Rules[I].Name); 1785 | J:=0; 1786 | 1787 | For K:=0 To Pred(Rules[I].Lines[J].EntryCount) Do 1788 | Begin 1789 | Node.AddField(Rules[I].Lines[J].EntryList[K]); 1790 | 1791 | If Rules[I].Lines[J].EntryList[K].IsLookAhead Then 1792 | Node.LookAheadIndex := K; 1793 | 1794 | If Rules[I].Lines[J].EntryList[K].IsImportant Then 1795 | Node.ImportantIndex := K; 1796 | End; 1797 | End; 1798 | 1799 | rule_Set: 1800 | Begin 1801 | PreNode := GetNode(Rules[I].Name); 1802 | For J:=0 To Pred(Rules[I].LineCount) Do 1803 | Begin 1804 | S := Rules[I].Name + Rules[I].Lines[J].EntryList[0].Annotation; 1805 | Node := GetNode(S); 1806 | Node.Parent := PreNode; 1807 | Node.AddField(Rules[I].Lines[J].EntryList[0]); 1808 | //MySet.AddValue(Rules[I].Lines[J].EntryList[0].Value, Rules[I].Lines[J].EntryList[0].Annotation);} 1809 | End; 1810 | 1811 | { MySet := GetSet(Rules[I].Name); 1812 | For J:=0 To Pred(Rules[I].LineCount) Do 1813 | MySet.AddValue(Rules[I].Lines[J].EntryList[0].Value, Rules[I].Lines[J].EntryList[0].Annotation);} 1814 | End; 1815 | 1816 | End; 1817 | End; 1818 | 1819 | For I:=0 To Pred(NodeCount) Do 1820 | Begin 1821 | If (Nodes[I].Parent = Nodes[I]) Then 1822 | Nodes[I].Parent := Nil; 1823 | 1824 | If (Nodes[I].Parent = Nil) Then 1825 | Nodes[I].Parent := GetParent(Nodes[I].Name); 1826 | End; 1827 | 1828 | I:=0; 1829 | While I0) Then 1859 | Begin 1860 | For J:=0 To Pred(Nodes[I].FieldCount) Do 1861 | If (Nodes[I].Fields[J].Entry.Kind = grammar_Rule) And (Nodes[I].Fields[J].Entry.ListID>0) Then 1862 | Begin 1863 | S := Nodes[I].Fields[J].Entry.Value+'Node'; 1864 | 1865 | Other := Self.GetNode(Nodes[I].Fields[J].Entry.Value); 1866 | If (Assigned(Other)) And (Not Other.Declared) Then 1867 | Begin 1868 | Dest.WriteLine(#9+S+' = Class;'); 1869 | End; 1870 | 1871 | If (Assigned(Other)) And (Not Other.ArrayDeclared) Then 1872 | Begin 1873 | Dest.WriteLine(#9+S+'Array = Array Of '+S+';'); 1874 | Other.ArrayDeclared := True; 1875 | End; 1876 | 1877 | Dest.WriteLine(); 1878 | End; 1879 | End; 1880 | 1881 | Dest.WriteLine(#9+Nodes[I].Name+'Node = Class('+Parent+')'); 1882 | 1883 | HasRegExpr := False; 1884 | 1885 | Nodes[I].Declared := True; 1886 | 1887 | If (Nodes[I].FieldCount>0) Then 1888 | Begin 1889 | Dest.WriteLine(#9#9+'Public'); 1890 | S3 := ''; 1891 | For J:=0 To Pred(Nodes[I].FieldCount) Do 1892 | If Not Nodes[I].Fields[J].Entry.Null Then 1893 | Begin 1894 | S2 := Nodes[I].Fields[J].Name; 1895 | 1896 | If Nodes[I].Fields[J].Entry.Kind = grammar_Rule Then 1897 | Begin 1898 | S := Nodes[I].Fields[J].Entry.Value+'Node'; 1899 | 1900 | If Nodes[I].Fields[J].Entry.ListID>0 Then 1901 | Begin 1902 | S2 := S2 +'s'; 1903 | S := S +'Array'//;'Array Of '+S; 1904 | End; 1905 | 1906 | Prefix := ''; 1907 | End Else 1908 | If Nodes[I].Fields[J].Entry.Kind = grammar_RegExpr Then 1909 | Begin 1910 | If Nodes[I].Fields[J].Entry.CustomType<>'' Then 1911 | S := Nodes[I].Fields[J].Entry.CustomType 1912 | Else 1913 | S := 'TERRAString'; 1914 | 1915 | Prefix := 'Const '; 1916 | HasRegExpr := True; 1917 | End Else 1918 | If (Nodes[I].Fields[J].Entry.Kind = grammar_Token) And (Nodes[I].Fields[J].Entry.GenType<>'') Then 1919 | Begin 1920 | S2 := Nodes[I].Fields[J].Entry.Annotation; 1921 | S := Nodes[I].Fields[J].Entry.GenType; 1922 | Prefix := 'Const '; 1923 | End Else 1924 | Continue; 1925 | 1926 | Dest.WriteLine(#9#9#9+S2+': '+S+';'); 1927 | 1928 | {If Nodes[I].Fields[J].Entry.List Then 1929 | Begin 1930 | Dest.WriteLine(#9#9#9+Nodes[I].Fields[J].Name+'Count:Integer;'); 1931 | End;} 1932 | 1933 | If S3<>'' Then 1934 | S3 := S3 + '; '; 1935 | 1936 | S3 := S3 + Prefix + S2+':'+S; 1937 | End; 1938 | 1939 | { If S3<>'' Then 1940 | S3 := '; ' + S3;} 1941 | 1942 | Dest.WriteLine(); 1943 | Dest.WriteLine(#9#9#9+'Constructor Create('+S3+');'); 1944 | 1945 | If HasRegExpr Then 1946 | Begin 1947 | Dest.WriteLine(#9#9#9+'Function GetValue():TERRAString; Override;'); 1948 | End; 1949 | End; 1950 | 1951 | Dest.WriteLine(#9+'End;'); 1952 | Dest.WriteLine(); 1953 | End; 1954 | 1955 | 1956 | Dest.WriteLine(); 1957 | End; 1958 | 1959 | procedure Grammar.GenerateNodesImplementation(Dest: Stream); 1960 | Var 1961 | I,J:Integer; 1962 | Conversion, CustomType, S, S2,S3,S4, S5:TERRAString; 1963 | begin 1964 | For I:=0 To Pred(NodeCount) Do 1965 | If (Nodes[I].FieldCount>0) Then 1966 | Begin 1967 | S := ''; 1968 | For J:=0 To Pred(Nodes[I].FieldCount) Do 1969 | If (Not Nodes[I].Fields[J].Entry.Null) Then 1970 | Begin 1971 | S5 := Nodes[I].Fields[J].Name; 1972 | S3 := ''; 1973 | 1974 | Case Nodes[I].Fields[J].Entry.Kind Of 1975 | grammar_Token: 1976 | If (Nodes[I].Fields[J].Entry.GenType<>'') Then 1977 | Begin 1978 | S5 := Nodes[I].Fields[J].Entry.Annotation; 1979 | S2 := Nodes[I].Fields[J].Entry.GenType; 1980 | S3 := 'Const '; 1981 | End Else 1982 | Continue; 1983 | 1984 | grammar_Rule: 1985 | Begin 1986 | S2 := Nodes[I].Fields[J].Node.Name+ 'Node'; 1987 | If Nodes[I].Fields[J].Entry.ListID>0 Then 1988 | Begin 1989 | S5 := S5 +'s'; 1990 | S2 := S2+'Array'; 1991 | End; 1992 | End; 1993 | 1994 | grammar_RegExpr: 1995 | Begin 1996 | If Nodes[I].Fields[J].Entry.CustomType<>'' Then 1997 | S2 := Nodes[I].Fields[J].Entry.CustomType 1998 | Else 1999 | S2 := 'TERRAString'; 2000 | 2001 | S3 := 'Const '; 2002 | End; 2003 | End; 2004 | 2005 | If S<>'' Then 2006 | S := S + '; '; 2007 | 2008 | S := S + S3 + S5+':'+S2; 2009 | End; 2010 | 2011 | { If I>0 Then 2012 | Begin 2013 | If S<>'' Then 2014 | S := '; '+S; 2015 | S := 'Parent:ASTNode'+S; 2016 | End;} 2017 | 2018 | Dest.WriteLine('Constructor '+Nodes[I].Name+'Node.Create('+S+');'); 2019 | For J:=0 To Pred(Nodes[I].FieldCount) Do 2020 | If Nodes[I].Fields[J].Entry.ListID>0 Then 2021 | Begin 2022 | Dest.WriteLine('Var'); 2023 | Dest.WriteLine(#9'I:Integer;'); 2024 | Break; 2025 | End; 2026 | 2027 | Dest.WriteLine('Begin'); 2028 | For J:=0 To Pred(Nodes[I].FieldCount) Do 2029 | If (Nodes[I].Fields[J].Entry.Kind <> grammar_Token) And (Not Nodes[I].Fields[J].Entry.Null) Then 2030 | Begin 2031 | S5 := Nodes[I].Fields[J].Name; 2032 | S4 := Nodes[I].Fields[J].Name; 2033 | 2034 | If Nodes[I].Fields[J].Entry.ListID>0 Then 2035 | Begin 2036 | S4 := S4 + 's'; 2037 | S5 := S5 + 's'; 2038 | End; 2039 | 2040 | Dest.WriteLine(#9+'Self.'+S5+' := '+S4+';'); 2041 | 2042 | If Nodes[I].Fields[J].Entry.Kind<>Grammar_Rule Then 2043 | Continue; 2044 | 2045 | Dest.WriteLine(#9+'If Assigned('+S5+') Then'); 2046 | If Nodes[I].Fields[J].Entry.ListID>0 Then 2047 | Begin 2048 | Dest.WriteLine(#9#9+'For I:=0 To Pred(Length('+S5+')) Do'); 2049 | Dest.WriteLine(#9#9#9+S5+'[I].SetParent(Self);'); 2050 | End Else 2051 | Dest.WriteLine(#9#9+S5+'.SetParent(Self);'); 2052 | 2053 | End; 2054 | Dest.WriteLine('End;'); 2055 | Dest.WriteLine(); 2056 | 2057 | For J:=0 To Pred(Nodes[I].FieldCount) Do 2058 | If Nodes[I].Fields[J].Entry.Kind = grammar_regExpr Then 2059 | Begin 2060 | Dest.WriteLine('Function '+Nodes[I].Name+'Node.GetValue():TERRAString;'); 2061 | Dest.WriteLine('Begin'); 2062 | 2063 | CustomType := Nodes[I].Fields[J].Entry.CustomType; 2064 | If (StringEquals(CustomType, 'Double')) Or (StringEquals(CustomType, 'Single'))Then 2065 | Conversion := 'FloatToString' 2066 | Else 2067 | If (StringEquals(CustomType, 'Boolean')) Then 2068 | Conversion := 'BoolToString' 2069 | Else 2070 | If (StringEquals(CustomType, 'Cardinal')) Then 2071 | Conversion := 'CardinalToString' 2072 | Else 2073 | If (StringEquals(CustomType, 'Integer')) Then 2074 | Conversion := 'IntToString' 2075 | Else 2076 | Conversion := ''; 2077 | 2078 | If Conversion<>'' Then 2079 | Dest.WriteLine(#9+'Result := '+Conversion+'(Value);') 2080 | Else 2081 | Dest.WriteLine(#9+'Result := Value;'); 2082 | Dest.WriteLine('End;'); 2083 | 2084 | Dest.WriteLine(); 2085 | Break; 2086 | End; 2087 | End; 2088 | end; 2089 | 2090 | Procedure Grammar.GenerateParserInterface(Dest: Stream); 2091 | Var 2092 | I, J:Integer; 2093 | S2, S3:TERRAString; 2094 | Begin 2095 | Dest.WriteLine(#9+Self.Name+'Parser = Class(Parser)'); 2096 | Dest.WriteLine(#9#9+'Protected'); 2097 | For I:=0 To Pred(NodeCount) Do 2098 | Begin 2099 | Nodes[I].ChildrenCount := 0; 2100 | 2101 | For J:=0 To Pred(NodeCount) Do 2102 | If (Nodes[J].Parent = Nodes[I]) Then 2103 | Begin 2104 | Inc(Nodes[I].ChildrenCount); 2105 | SetLength(Nodes[I].Children, Nodes[I].ChildrenCount); 2106 | Nodes[I].Children[Pred(Nodes[I].ChildrenCount)] := Nodes[J]; 2107 | End; 2108 | 2109 | If Nodes[I].LookAheadIndex>=0 Then 2110 | Continue; 2111 | 2112 | If I=0 Then 2113 | Begin 2114 | S2 := 'ASTNode; Override;'; 2115 | End Else 2116 | Begin 2117 | S2 := Nodes[I].Name+'Node;'; 2118 | End; 2119 | 2120 | If I>0 Then 2121 | S3 := Nodes[I].GenArgs() 2122 | Else 2123 | S3 := ''; 2124 | 2125 | Dest.WriteLine(#9#9#9+'Function Parse'+Nodes[I].Name+'('+S3+'):'+S2); 2126 | End; 2127 | 2128 | Dest.WriteLine(#9#9#9+'Function GetTokenName(ID:Cardinal; Const Value:TERRAString):TERRAString; Override;'); 2129 | 2130 | Dest.WriteLine(#9#9+'Public'); 2131 | //Dest.WriteLine(#9#9#9+'Constructor Create();'); 2132 | Dest.WriteLine(#9#9#9+'Function Parse(Source:Stream; IgnoreCase:Boolean):ASTNode; Override;'); 2133 | 2134 | Dest.WriteLine(#9+'End;'); 2135 | 2136 | Dest.WriteLine(); 2137 | End; 2138 | 2139 | Procedure Grammar.GenerateParserImplementation(Dest: Stream); 2140 | Var 2141 | I, J, K:Integer; 2142 | S, OptArg, IsOpt, NodeKind:TERRAString; 2143 | HasLabels:Boolean; 2144 | Begin 2145 | Dest.WriteLine(); 2146 | 2147 | { Dest.WriteLine('Constructor '+Self.Name+'Parser.Create();'); 2148 | Dest.WriteLine('Begin'); 2149 | For I:=0 To Pred(RuleCount) Do 2150 | If (Rules[I].Preprocessor) Then 2151 | Begin 2152 | Dest.WriteLine(#9+'AddPreProcessorMatcher('+Rules[I].Name+'PreProcessorMatcher.Create());'); 2153 | End; 2154 | 2155 | Dest.WriteLine('End;'); 2156 | Dest.WriteLine();} 2157 | 2158 | Dest.WriteLine('Function '+Self.Name+'Parser.Parse(Source:Stream; IgnoreCase:Boolean):ASTNode;'); 2159 | Dest.WriteLine('Begin'); 2160 | Dest.WriteLine(#9'_Lexer := '+Self.Name+'Lexer.Create();'); 2161 | Dest.WriteLine(#9'Result := Inherited Parse(Source, IgnoreCase);'); 2162 | Dest.WriteLine('End;'); 2163 | Dest.WriteLine(); 2164 | 2165 | Dest.WriteLine('Function '+Self.Name+'Parser.GetTokenName(ID:Cardinal; Const Value:TERRAString):TERRAString;'); 2166 | Dest.WriteLine('Begin'); 2167 | Dest.WriteLine(#9'Case ID Of'); 2168 | For I:=1 To Pred(LastTokenID) Do 2169 | Begin 2170 | {If Tokens[I].RegExpr Then 2171 | S := StringLower(Tokens[I].Name) 2172 | Else 2173 | S := Tokens[I].Value;} 2174 | 2175 | S := TokenNames[I]; 2176 | 2177 | 2178 | Dest.WriteLine(#9#9+CardinalToString(I)+': Result := '''+S+''';'); 2179 | End; 2180 | Dest.WriteLine(#9'Else'); 2181 | Dest.WriteLine(#9#9'Result := CardinalToString(ID);'); 2182 | Dest.WriteLine(#9'End;'); 2183 | Dest.WriteLine(#9'Result := ''[''+Result+'']'';'); 2184 | Dest.WriteLine('End;'); 2185 | Dest.WriteLine(); 2186 | 2187 | 2188 | For I:=0 To Pred(NodeCount) Do 2189 | Begin 2190 | If I = 0 Then 2191 | NodeKind := 'AST' 2192 | Else 2193 | NodeKind := Nodes[I].Name; 2194 | 2195 | 2196 | If I=0 Then 2197 | Begin 2198 | OptArg := ''; 2199 | IsOpt := 'False'; 2200 | End Else 2201 | Begin 2202 | OptArg := Nodes[I].GenArgs(); 2203 | IsOpt := 'IsOpt'; 2204 | End; 2205 | 2206 | { If (I>0) Then 2207 | Begin 2208 | If S3<>'' Then 2209 | S3 := '; ' +S3; 2210 | S3 := 'Parent:ASTNode'+S3; 2211 | End;} 2212 | 2213 | If Nodes[I].LookAheadIndex>=0 Then 2214 | Continue; 2215 | 2216 | Dest.WriteLine('Function '+Self.Name+'Parser.Parse'+Nodes[I].Name+'('+OptArg+'):'+NodeKind+'Node;'); 2217 | 2218 | If (Nodes[I].FieldCount>0) Then 2219 | Nodes[I].GenCompoundNode(Dest, (I>0), IsOpt) 2220 | Else 2221 | Nodes[I].GenAbstractNode(Dest, (I>0), IsOpt); 2222 | 2223 | Dest.WriteLine('End;'); 2224 | Dest.WriteLine(); 2225 | End; 2226 | End; 2227 | 2228 | Procedure Grammar.GenerateTokenImplementation(Dest: Stream); 2229 | Var 2230 | I,J, K:Integer; 2231 | S, S2:TERRAString; 2232 | Begin 2233 | For I:=1 To Pred(TokenCount) Do 2234 | If Tokens[I].RegExpr Then 2235 | Begin 2236 | { Dest.WriteLine('Constructor RegexMatcher'+Tokens[I].Name+'.Create(Token:Cardinal);'); 2237 | Dest.WriteLine('Begin'); 2238 | Dest.WriteLine(#9+' Self._Token := Token;'); 2239 | Dest.WriteLine('End;'); 2240 | Dest.WriteLine();} 2241 | 2242 | Dest.WriteLine('Function '+Tokens[I].Name+'RegexMatcher.Match(Const C:TERRAChar):Boolean;'); 2243 | Dest.WriteLine('Begin'); 2244 | 2245 | If (Tokens[I].RegExpr) Then 2246 | Tokens[I].GenerateRegExp(Dest) 2247 | Else 2248 | Tokens[I].GenerateStringMatch(Dest); 2249 | 2250 | Dest.WriteLine('End;'); 2251 | Dest.WriteLine(); 2252 | End; 2253 | End; 2254 | 2255 | Procedure Grammar.GenerateLexerInterface(Dest: Stream); 2256 | Begin 2257 | Dest.WriteLine(#9+Self.Name+'Lexer = Class(Lexer)'); 2258 | Dest.WriteLine(#9#9+'Public'); 2259 | Dest.WriteLine(#9#9#9+'Constructor Create();'); 2260 | Dest.WriteLine(#9+'End;'); 2261 | Dest.WriteLine(); 2262 | End; 2263 | 2264 | Procedure Grammar.GenerateLexerImplementation(Dest: Stream); 2265 | Var 2266 | S2, Comment, TokenValue:TERRAString; 2267 | I, Priority:Integer; 2268 | Begin 2269 | Dest.WriteLine('Constructor '+Self.Name+'Lexer.Create();'); 2270 | Dest.WriteLine('Begin'); 2271 | For I:=1 To Pred(TokenCount) Do 2272 | Begin 2273 | If Tokens[I].Discard Then 2274 | S2 := 'lexerDiscard' 2275 | Else 2276 | S2 := 'lexerAccept'; 2277 | 2278 | TokenValue := CardinalToString(Tokens[I].ID); 2279 | 2280 | Comment := Tokens[I].Value; 2281 | StringReplaceText(StringFromChar(NewLineChar), '\n', Comment); 2282 | 2283 | If Tokens[I].RegExpr Then 2284 | Begin 2285 | If (StringContains(']*', Tokens[I].Value)) Then 2286 | Priority := 0 2287 | Else 2288 | If (StringContains(']+', Tokens[I].Value)) Then 2289 | Priority := 1 2290 | Else 2291 | If (StringContains(']?', Tokens[I].Value)) Then 2292 | Priority := 1 2293 | Else 2294 | Priority := 3; 2295 | Dest.WriteLine(#9+'AddMatcher('+Tokens[I].Name+'RegexMatcher.Create('+TokenValue+', '+IntToString(Priority)+', '+S2+')); // '+Comment); 2296 | End Else 2297 | If StringLength(Tokens[I].Value)>1 Then 2298 | Dest.WriteLine(#9+'AddMatcher(StringTokenMatcher.Create('+TokenValue+', '''+Tokens[I].Value+''', '+S2+'));') 2299 | Else 2300 | Dest.WriteLine(#9+'AddMatcher(CharTokenMatcher.Create('+TokenValue+', '+CardinalToString(StringFirstChar(Tokens[I].Value))+', '+S2+')); // '+Comment); 2301 | End; 2302 | Dest.WriteLine('End;'); 2303 | Dest.WriteLine(); 2304 | End; 2305 | 2306 | procedure Grammar.GenerateVisitorInterface(Dest: Stream); 2307 | Var 2308 | I:Integer; 2309 | Begin 2310 | Dest.WriteLine(#9+Self.Name+'Processor = Class(TERRAObject)'); 2311 | Dest.WriteLine(#9#9+'Public'); 2312 | 2313 | For I:=0 To Pred(NodeCount) Do 2314 | Begin 2315 | Dest.WriteLine(#9#9#9+'Procedure Visit'+Nodes[I].Name+'(Node:'+Nodes[I].Name+'Node); Virtual;'); 2316 | End; 2317 | 2318 | Dest.WriteLine(#9+'End;'); 2319 | Dest.WriteLine(); 2320 | End; 2321 | 2322 | Procedure Grammar.GenerateVisitorImplementation(Dest: Stream); 2323 | Var 2324 | I,J:Integer; 2325 | Begin 2326 | For I:=0 To Pred(NodeCount) Do 2327 | Begin 2328 | Dest.WriteLine('Procedure '+Self.Name+'Processor.Visit'+Nodes[I].Name+'(Node:'+Nodes[I].Name+'Node);'); 2329 | 2330 | For J:=0 To Pred(Nodes[I].FieldCount) Do 2331 | If (Nodes[I].Fields[J].Entry.Kind = grammar_Rule) And (Nodes[I].Fields[J].Entry.ListID>0) And (Not Nodes[I].Fields[J].Entry.Null) Then 2332 | Begin 2333 | Dest.WriteLine('Var'); 2334 | Dest.WriteLine(#9'I:Integer;'); 2335 | End; 2336 | 2337 | Dest.WriteLine('Begin'); 2338 | 2339 | If (Nodes[I].FieldCount>0) Then 2340 | Begin 2341 | For J:=0 To Pred(Nodes[I].FieldCount) Do 2342 | If (Nodes[I].Fields[J].Entry.Kind = grammar_Rule) And (Not Nodes[I].Fields[J].Entry.Null) Then 2343 | Begin 2344 | If Nodes[I].Fields[J].Entry.ListID>0 Then 2345 | Begin 2346 | Dest.WriteLine(#9'For I:=0 To Pred(Length(Node.'+Nodes[I].Fields[J].Node.Name+'s)) Do'); 2347 | Dest.WriteLine(#9#9'Visit'+Nodes[I].Fields[J].Node.Name+'(Node.'+Nodes[I].Fields[J].Name+'s[I]);'); 2348 | End Else 2349 | Dest.WriteLine(#9'Visit'+Nodes[I].Fields[J].Node.Name+'(Node.'+Nodes[I].Fields[J].Name+');'); 2350 | End; 2351 | End Else 2352 | Begin 2353 | For J:=0 To Pred(Nodes[I].ChildrenCount) Do 2354 | Begin 2355 | Dest.WriteLine(#9'If (Node Is '+Nodes[I].Children[J].Name+'Node) Then'); 2356 | Dest.WriteLine(#9#9'Visit'+Nodes[I].Children[J].Name+'('+Nodes[I].Children[J].Name+'Node(Node))'); 2357 | Dest.WriteLine(#9'Else'); 2358 | End; 2359 | End; 2360 | Dest.WriteLine('End;'); 2361 | Dest.WriteLine(); 2362 | End; 2363 | End; 2364 | 2365 | 2366 | 2367 | (*procedure Grammar.GeneratePreProcessorInterface(Dest: Stream); 2368 | Var 2369 | I,J:Integer; 2370 | begin 2371 | For I:=0 To Pred(RuleCount) Do 2372 | If (Rules[I].Preprocessor) Then 2373 | Begin 2374 | Dest.WriteLine(#9+Rules[I].Name+'PreProcessorMatcher = Class(PreProcessorMatcher)'); 2375 | 2376 | Dest.WriteLine(#9#9+'Function Match(Token:LexerToken):Boolean; Override;'); 2377 | Dest.WriteLine(#9#9+'Procedure Consume(Token:LexerToken); Override;'); 2378 | 2379 | Dest.WriteLine(#9+'End;'); 2380 | Dest.WriteLine(); 2381 | End; 2382 | End; 2383 | 2384 | procedure Grammar.GeneratePreProcessorImplementation(Dest: Stream); 2385 | Var 2386 | I,J:Integer; 2387 | begin 2388 | For I:=0 To Pred(RuleCount) Do 2389 | If (Rules[I].Preprocessor) Then 2390 | Begin 2391 | Dest.WriteLine('Function '+Rules[I].Name+'PreProcessorMatcher.Match(Token:LexerToken):Boolean;'); 2392 | Dest.WriteLine('Begin'); 2393 | Dest.WriteLine('End;'); 2394 | Dest.WriteLine(); 2395 | 2396 | Dest.WriteLine('Procedure '+Rules[I].Name+'PreProcessorMatcher.Consume(Token:LexerToken);'); 2397 | Dest.WriteLine('Begin'); 2398 | Dest.WriteLine('End;'); 2399 | Dest.WriteLine(); 2400 | End; 2401 | End;*) 2402 | 2403 | 2404 | Procedure Grammar.Generate(Dest: Stream); 2405 | Var 2406 | S:TERRAString; 2407 | Begin 2408 | Dest.WriteLine('Unit '+ Self.Name+';'); 2409 | Dest.WriteLine(); 2410 | Dest.WriteLine('{$I terra.inc}'); 2411 | Dest.WriteLine(); 2412 | Dest.WriteLine('Interface'); 2413 | Dest.WriteLine('Uses TERRA_String, TERRA_Utils, TERRA_Stream, TERRA_Lexer, TERRA_Parser;'); 2414 | Dest.WriteLine(); 2415 | 2416 | Dest.WriteLine('Type'); 2417 | GenerateTokenInterface(Dest); 2418 | GenerateNodesInterface(Dest); 2419 | // GeneratePreProcessorInterface(Dest); 2420 | GenerateLexerInterface(Dest); 2421 | GenerateVisitorInterface(Dest); 2422 | GenerateParserInterface(Dest); 2423 | 2424 | Dest.WriteLine('Implementation'); 2425 | Dest.WriteLine('Uses TERRA_Error;'); 2426 | Dest.WriteLine(); 2427 | 2428 | GenerateTokenImplementation(Dest); 2429 | GenerateNodesImplementation(Dest); 2430 | // GeneratePreProcessorImplementation(Dest); 2431 | GenerateLexerImplementation(Dest); 2432 | GenerateVisitorImplementation(Dest); 2433 | GenerateParserImplementation(Dest); 2434 | 2435 | Dest.WriteLine(); 2436 | Dest.WriteLine('End.'); 2437 | 2438 | End; 2439 | 2440 | 2441 | 2442 | Var 2443 | G:Grammar; 2444 | S:TERRAString; 2445 | Dest:Stream; 2446 | 2447 | 2448 | Begin 2449 | {If ParamCount<1 Then 2450 | Begin 2451 | WriteLn('Sintax: ProgName '); 2452 | Halt(1); 2453 | End; 2454 | 2455 | S := ParamStr(1);} 2456 | 2457 | S := 'delphi.grammar'; 2458 | //S := 'xml.grammar'; 2459 | 2460 | G := Grammar.Create(S); 2461 | 2462 | 2463 | Dest := FileStream.Create(G.Name+'.pas'); 2464 | Dest.Encoding := encodingASCII; 2465 | Dest.EOL := EOL_Windows; 2466 | //Dest := MemoryStream.Create(32); 2467 | G.Generate(Dest); 2468 | G.Destroy(); 2469 | 2470 | 2471 | { Dest.Seek(0); 2472 | While Not Dest.EOF Do 2473 | Begin 2474 | Dest.ReadLine(S); 2475 | WriteLn(S); 2476 | End;} 2477 | ReleaseObject(Dest); 2478 | 2479 | FloatToString(0.5e+23); 2480 | 2481 | WrIteLn('Finished!'); 2482 | ReadLn; 2483 | End. 2484 | --------------------------------------------------------------------------------