├── LICENSE ├── Pas2Dart.lpi ├── Pas2Dart.lps ├── Pas2Dart.pas ├── README.md ├── pastree.pp ├── paswrite.pp ├── pparser.pp └── pscanner.pp /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /Pas2Dart.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <i18n> 18 | <EnableI18N LFM="False"/> 19 | </i18n> 20 | <BuildModes Count="3"> 21 | <Item1 Name="Default" Default="True"/> 22 | <Item2 Name="Debug"> 23 | <CompilerOptions> 24 | <Version Value="11"/> 25 | <PathDelim Value="\"/> 26 | <Target> 27 | <Filename Value="Pas2Dart"/> 28 | </Target> 29 | <SearchPaths> 30 | <IncludeFiles Value="$(ProjOutDir)"/> 31 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 32 | </SearchPaths> 33 | <Parsing> 34 | <SyntaxOptions> 35 | <IncludeAssertionCode Value="True"/> 36 | </SyntaxOptions> 37 | </Parsing> 38 | <CodeGeneration> 39 | <Checks> 40 | <IOChecks Value="True"/> 41 | <RangeChecks Value="True"/> 42 | <OverflowChecks Value="True"/> 43 | <StackChecks Value="True"/> 44 | </Checks> 45 | </CodeGeneration> 46 | <Linking> 47 | <Debugging> 48 | <DebugInfoType Value="dsDwarf2Set"/> 49 | <UseExternalDbgSyms Value="True"/> 50 | </Debugging> 51 | </Linking> 52 | </CompilerOptions> 53 | </Item2> 54 | <Item3 Name="Release"> 55 | <CompilerOptions> 56 | <Version Value="11"/> 57 | <PathDelim Value="\"/> 58 | <Target> 59 | <Filename Value="Pas2Dart"/> 60 | </Target> 61 | <SearchPaths> 62 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 63 | </SearchPaths> 64 | <CodeGeneration> 65 | <SmartLinkUnit Value="True"/> 66 | <Optimizations> 67 | <OptimizationLevel Value="3"/> 68 | </Optimizations> 69 | </CodeGeneration> 70 | <Linking> 71 | <Debugging> 72 | <GenerateDebugInfo Value="False"/> 73 | </Debugging> 74 | <LinkSmart Value="True"/> 75 | </Linking> 76 | </CompilerOptions> 77 | </Item3> 78 | </BuildModes> 79 | <PublishOptions> 80 | <Version Value="2"/> 81 | </PublishOptions> 82 | <RunParams> 83 | <local> 84 | <CommandLineParams Value="D:\TRM\branches\DSV_20170713002\construcao\fontes\Tela.pas"/> 85 | </local> 86 | <FormatVersion Value="2"/> 87 | <Modes Count="1"> 88 | <Mode0 Name="default"> 89 | <local> 90 | <CommandLineParams Value="D:\TRM\branches\DSV_20170713002\construcao\fontes\Tela.pas"/> 91 | </local> 92 | </Mode0> 93 | </Modes> 94 | </RunParams> 95 | <Units Count="1"> 96 | <Unit0> 97 | <Filename Value="Pas2Dart.pas"/> 98 | <IsPartOfProject Value="True"/> 99 | </Unit0> 100 | </Units> 101 | </ProjectOptions> 102 | <CompilerOptions> 103 | <Version Value="11"/> 104 | <PathDelim Value="\"/> 105 | <Target> 106 | <Filename Value="Pas2Dart"/> 107 | </Target> 108 | <SearchPaths> 109 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 110 | </SearchPaths> 111 | </CompilerOptions> 112 | <Debugging> 113 | <Exceptions Count="4"> 114 | <Item1> 115 | <Name Value="EAbort"/> 116 | </Item1> 117 | <Item2> 118 | <Name Value="ECodetoolError"/> 119 | </Item2> 120 | <Item3> 121 | <Name Value="EFOpenError"/> 122 | </Item3> 123 | <Item4> 124 | <Name Value="EReadError"/> 125 | </Item4> 126 | </Exceptions> 127 | </Debugging> 128 | </CONFIG> 129 | -------------------------------------------------------------------------------- /Pas2Dart.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="11"/> 6 | <BuildModes Active="Debug"/> 7 | <Units Count="13"> 8 | <Unit0> 9 | <Filename Value="Pas2Dart.pas"/> 10 | <IsPartOfProject Value="True"/> 11 | <TopLine Value="87"/> 12 | <CursorPos Y="104"/> 13 | <UsageCount Value="202"/> 14 | <Loaded Value="True"/> 15 | </Unit0> 16 | <Unit1> 17 | <Filename Value="pparser.pp"/> 18 | <UnitName Value="PParser"/> 19 | <EditorIndex Value="2"/> 20 | <TopLine Value="568"/> 21 | <CursorPos Y="576"/> 22 | <UsageCount Value="158"/> 23 | <Loaded Value="True"/> 24 | </Unit1> 25 | <Unit2> 26 | <Filename Value="pastree.pp"/> 27 | <UnitName Value="PasTree"/> 28 | <EditorIndex Value="4"/> 29 | <TopLine Value="102"/> 30 | <CursorPos X="3" Y="120"/> 31 | <UsageCount Value="101"/> 32 | <Loaded Value="True"/> 33 | </Unit2> 34 | <Unit3> 35 | <Filename Value="Pas2Groovy.groovy"/> 36 | <EditorIndex Value="-1"/> 37 | <TopLine Value="7"/> 38 | <CursorPos X="20" Y="65"/> 39 | <UsageCount Value="101"/> 40 | <DefaultSyntaxHighlighter Value="None"/> 41 | </Unit3> 42 | <Unit4> 43 | <Filename Value="test_parser.pp"/> 44 | <UnitName Value="test_parser1"/> 45 | <EditorIndex Value="-1"/> 46 | <TopLine Value="274"/> 47 | <CursorPos X="24" Y="145"/> 48 | <UsageCount Value="57"/> 49 | </Unit4> 50 | <Unit5> 51 | <Filename Value="pscanner.pp"/> 52 | <UnitName Value="PScanner"/> 53 | <EditorIndex Value="3"/> 54 | <TopLine Value="3701"/> 55 | <CursorPos X="3" Y="3717"/> 56 | <UsageCount Value="126"/> 57 | <Loaded Value="True"/> 58 | </Unit5> 59 | <Unit6> 60 | <Filename Value="Tela.groovy"/> 61 | <EditorIndex Value="-1"/> 62 | <TopLine Value="496"/> 63 | <CursorPos Y="1300"/> 64 | <UsageCount Value="107"/> 65 | <DefaultSyntaxHighlighter Value="None"/> 66 | </Unit6> 67 | <Unit7> 68 | <Filename Value="..\Tela.pas"/> 69 | <EditorIndex Value="-1"/> 70 | <TopLine Value="145"/> 71 | <CursorPos X="28" Y="1211"/> 72 | <UsageCount Value="107"/> 73 | </Unit7> 74 | <Unit8> 75 | <Filename Value="..\TRMConsts.pas"/> 76 | <EditorIndex Value="-1"/> 77 | <TopLine Value="82"/> 78 | <UsageCount Value="103"/> 79 | </Unit8> 80 | <Unit9> 81 | <Filename Value="..\IBMUtils.pas"/> 82 | <EditorIndex Value="-1"/> 83 | <CursorPos X="18" Y="78"/> 84 | <UsageCount Value="102"/> 85 | </Unit9> 86 | <Unit10> 87 | <Filename Value="..\Loops.pas"/> 88 | <EditorIndex Value="-1"/> 89 | <TopLine Value="106"/> 90 | <CursorPos X="3" Y="137"/> 91 | <UsageCount Value="21"/> 92 | </Unit10> 93 | <Unit11> 94 | <Filename Value="..\TB27.pas"/> 95 | <EditorIndex Value="-1"/> 96 | <TopLine Value="450"/> 97 | <CursorPos X="3" Y="528"/> 98 | <UsageCount Value="82"/> 99 | </Unit11> 100 | <Unit12> 101 | <Filename Value="Pas2Dart.dart"/> 102 | <IsVisibleTab Value="True"/> 103 | <EditorIndex Value="1"/> 104 | <TopLine Value="15"/> 105 | <CursorPos X="84" Y="15"/> 106 | <UsageCount Value="10"/> 107 | <Loaded Value="True"/> 108 | <DefaultSyntaxHighlighter Value="None"/> 109 | </Unit12> 110 | </Units> 111 | <JumpHistory Count="30" HistoryIndex="29"> 112 | <Position1> 113 | <Filename Value="Pas2Dart.pas"/> 114 | <Caret Line="273" Column="11" TopLine="255"/> 115 | </Position1> 116 | <Position2> 117 | <Filename Value="Pas2Dart.pas"/> 118 | <Caret Line="117" Column="11" TopLine="99"/> 119 | </Position2> 120 | <Position3> 121 | <Filename Value="Pas2Dart.pas"/> 122 | <Caret Line="968" Column="126" TopLine="940"/> 123 | </Position3> 124 | <Position4> 125 | <Filename Value="Pas2Dart.pas"/> 126 | <Caret Line="273" Column="11" TopLine="255"/> 127 | </Position4> 128 | <Position5> 129 | <Filename Value="Pas2Dart.pas"/> 130 | <Caret Line="117" Column="11" TopLine="99"/> 131 | </Position5> 132 | <Position6> 133 | <Filename Value="Pas2Dart.pas"/> 134 | <Caret Line="964" Column="24" TopLine="945"/> 135 | </Position6> 136 | <Position7> 137 | <Filename Value="Pas2Dart.pas"/> 138 | <Caret Line="968" TopLine="945"/> 139 | </Position7> 140 | <Position8> 141 | <Filename Value="Pas2Dart.pas"/> 142 | <Caret Line="977" TopLine="945"/> 143 | </Position8> 144 | <Position9> 145 | <Filename Value="Pas2Dart.pas"/> 146 | <Caret Line="978" TopLine="945"/> 147 | </Position9> 148 | <Position10> 149 | <Filename Value="Pas2Dart.pas"/> 150 | <Caret Line="979" TopLine="945"/> 151 | </Position10> 152 | <Position11> 153 | <Filename Value="Pas2Dart.pas"/> 154 | <Caret Line="948" TopLine="945"/> 155 | </Position11> 156 | <Position12> 157 | <Filename Value="Pas2Dart.dart"/> 158 | <Caret TopLine="1116"/> 159 | </Position12> 160 | <Position13> 161 | <Filename Value="Pas2Dart.pas"/> 162 | <Caret Line="968" TopLine="945"/> 163 | </Position13> 164 | <Position14> 165 | <Filename Value="Pas2Dart.pas"/> 166 | <Caret Line="894" Column="15" TopLine="865"/> 167 | </Position14> 168 | <Position15> 169 | <Filename Value="Pas2Dart.pas"/> 170 | <Caret Line="893" Column="24" TopLine="878"/> 171 | </Position15> 172 | <Position16> 173 | <Filename Value="Pas2Dart.dart"/> 174 | <Caret Line="144" Column="40" TopLine="109"/> 175 | </Position16> 176 | <Position17> 177 | <Filename Value="Pas2Dart.pas"/> 178 | <Caret Line="901" TopLine="878"/> 179 | </Position17> 180 | <Position18> 181 | <Filename Value="Pas2Dart.pas"/> 182 | </Position18> 183 | <Position19> 184 | <Filename Value="Pas2Dart.pas"/> 185 | <Caret Line="8" Column="117"/> 186 | </Position19> 187 | <Position20> 188 | <Filename Value="Pas2Dart.pas"/> 189 | <Caret Line="13" Column="122"/> 190 | </Position20> 191 | <Position21> 192 | <Filename Value="Pas2Dart.pas"/> 193 | <Caret Line="117" Column="57" TopLine="103"/> 194 | </Position21> 195 | <Position22> 196 | <Filename Value="Pas2Dart.pas"/> 197 | </Position22> 198 | <Position23> 199 | <Filename Value="Pas2Dart.pas"/> 200 | <Caret Line="213" TopLine="198"/> 201 | </Position23> 202 | <Position24> 203 | <Filename Value="Pas2Dart.pas"/> 204 | <Caret Line="216" TopLine="198"/> 205 | </Position24> 206 | <Position25> 207 | <Filename Value="Pas2Dart.pas"/> 208 | <Caret Line="217" TopLine="198"/> 209 | </Position25> 210 | <Position26> 211 | <Filename Value="Pas2Dart.pas"/> 212 | <Caret Line="220" TopLine="198"/> 213 | </Position26> 214 | <Position27> 215 | <Filename Value="Pas2Dart.pas"/> 216 | <Caret Line="213" TopLine="198"/> 217 | </Position27> 218 | <Position28> 219 | <Filename Value="Pas2Dart.pas"/> 220 | <Caret Line="216" TopLine="198"/> 221 | </Position28> 222 | <Position29> 223 | <Filename Value="Pas2Dart.pas"/> 224 | <Caret Line="217" TopLine="198"/> 225 | </Position29> 226 | <Position30> 227 | <Filename Value="Pas2Dart.dart"/> 228 | <Caret Line="15" Column="84"/> 229 | </Position30> 230 | </JumpHistory> 231 | <RunParams> 232 | <FormatVersion Value="2"/> 233 | <Modes Count="0" ActiveMode="default"/> 234 | </RunParams> 235 | </ProjectSession> 236 | </CONFIG> 237 | -------------------------------------------------------------------------------- /Pas2Dart.pas: -------------------------------------------------------------------------------- 1 | program Pas2Dart; 2 | 3 | uses SysUtils, StrUtils, Math, Classes, PParser, PasTree; 4 | 5 | type 6 | TPasTree = class(TPasTreeContainer) 7 | public 8 | function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility; 9 | const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override; 10 | function FindElement(const AName: String): TPasElement; override; 11 | end; 12 | 13 | function TPasTree.CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility; 14 | const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; 15 | begin 16 | Result := AClass.Create(AName, AParent); 17 | Result.Visibility := AVisibility; 18 | Result.SourceFilename := ASourceFilename; 19 | Result.SourceLinenumber := ASourceLinenumber; 20 | end; 21 | 22 | function TPasTree.FindElement(const AName: String): TPasElement; 23 | begin // dummy implementation, see TFPDocEngine.FindElement for a real example 24 | Result := nil; 25 | end; 26 | 27 | var 28 | AliasTypes, EnumTypes: TStringList; 29 | G: Text; 30 | InFunction: Boolean = False; 31 | ByRefArgs: TStringList; 32 | FuncWithByRefs: TStringList; 33 | FuncsWithoutParams: String = '"DESTROY"'; 34 | 35 | const 36 | LF = ^M + ^J; 37 | TAB = ' '; 38 | 39 | function ListToStr(Lista: TStringList): String; 40 | var 41 | I: Integer; 42 | begin 43 | Result := ''; 44 | for I := 0 to Lista.Count - 1 do 45 | Result := Result + Lista[I] + IfThen(I < (Lista.Count - 1), ', ') 46 | end; 47 | 48 | function IsClassName(ClassName: String): Boolean; 49 | begin 50 | Result := (Length(ClassName) > 2) and (ClassName[1] = 'T') and (ClassName[2] in ['A'..'Z', '_']) and (ClassName[Length(ClassName)] in ['a'..'z', '0'..'9']) 51 | end; 52 | 53 | function ConvertClassName(ClassName: String): String; 54 | begin 55 | Result := ''; 56 | if ClassName = '' then Exit; 57 | Result := UpCase(ClassName[1]) + Copy(ClassName, 2, Length(ClassName)); 58 | if IsClassName(Result) then 59 | Result := Copy(Result, 2, Length(Result)); 60 | end; 61 | 62 | function TypeIsPrimitive(PasType: String): Boolean; 63 | const 64 | PrimitiveTypes: array[0..19] of String = ('string', 'boolean', 'char', 'integer', 'byte', 'single', 'real', 'double', 'extended', 'word', 65 | 'longint', 'cardinal', 'smallint', 'int64', 'comp', 'variant', 'const', 'TDate', 'pointer', 'TObject'); 66 | begin 67 | Result := AnsiIndexText(PasType, PrimitiveTypes) >= 0; 68 | end; 69 | 70 | function ConvertType(PasType: String; ConvertClass: Boolean = True): String; 71 | var 72 | I: Integer; 73 | const 74 | PascalTypes: array[0..26] of String = ('string', 'boolean', 'char', 'integer','byte', 'single', 'real', 'double', 'extended', 'word', 75 | 'longint', 'cardinal', 'smallint', 'int64', 'comp', 'variant', 'const', 'TDate', 'TList', 'TStringList', 'Text', 'procedure', 'pointer', 76 | 'TObject', 'TFPList', 'TObjectList', 'currency'); 77 | DartTypes: array[-1..26] of String = ('', 'String', 'bool', 'int', 'int', 'int', 'double', 'double', 'double', 'Decimal', 'int', 78 | 'int', 'int', 'int', 'int', 'BigInt', 'dynamic', 'Object', 'DateTime', 'List', 'List<String>', 'File', 'Function', 'Object', 79 | 'Object', 'List', 'List', 'Decimal'); 80 | begin 81 | if Pos('File ', PasType) <> 0 then 82 | Result := 'File' 83 | else 84 | begin 85 | I := AnsiIndexText(PasType, PascalTypes); 86 | Result := IfThen(I >= 0, DartTypes[I], AliasTypes.Values[PasType]); 87 | Result := IfThen(Result = '', IfThen(ConvertClass, ConvertClassName(PasType), PasType), Result); 88 | end; 89 | end; 90 | 91 | function CamelCase(Ident: String): String; 92 | begin 93 | Result := LowerCase(Ident[1]) + Copy(Ident, 2, Length(Ident)); 94 | end; 95 | 96 | function IsAllUpper(Ident: String): Boolean; 97 | var 98 | C: Char; 99 | begin 100 | Result := true; 101 | for C in Ident do 102 | if not(C in ['A'..'Z', '_']) then 103 | begin 104 | Result := false; 105 | Exit; 106 | end; 107 | end; 108 | 109 | function ConvertMember(PasMember: String): String; 110 | var 111 | I: Integer; 112 | const 113 | PascalMembers: array[0..9] of String = ('write', 'writeln', 'exit', 'inc', 'dec', 'halt', 'count', 'MAXINT', 'paramstr', 'paramcount'); 114 | DartMembers: array[0..9] of String = ('print', 'print', 'return', '++', '--', 'exit', 'length', '256', 'args', 'args.length'); 115 | begin 116 | Result := PasMember; 117 | if Pos('''', Result) <> 0 then 118 | Exit; 119 | if Length(Result) > 1 then 120 | begin 121 | if IsAllUpper(Result) then Exit; 122 | if Result[2] in ['A'..'Z'] then 123 | case LowerCase(Result[1]) of 124 | 'f': 125 | begin 126 | Result := '_' + CamelCase(Copy(Result, 2, 100)); 127 | Exit; 128 | end; 129 | 'e', 't': 130 | begin 131 | Result := Copy(Result, 2, 100); 132 | Exit; 133 | end; 134 | end; 135 | end; 136 | Result := CamelCase(Result); 137 | I := AnsiIndexText(Result, PascalMembers); 138 | if I >= 0 then 139 | begin 140 | Result := DartMembers[I]; 141 | if (Result = 'return') and (InFunction or (ByRefArgs.Count > 0)) then 142 | Result := Result + IfThen(ByRefArgs.Count > 0, ' [' + ListToStr(ByRefArgs) + ']', ' result'); 143 | end; 144 | end; 145 | 146 | type 147 | TFechamento = (ComChaves, SemChaves, SoInicio, SoFinal, ComChavesSemSalto); 148 | 149 | procedure WriteBlock(Block: TPasImplBlock; Indent: String; Aditional: String = ''; Fechamento: TFechamento = ComChaves); forward; 150 | procedure WriteImplElement(Comando:TPasImplElement; Indent: String; Aditional: String = ''; Fechamento: TFechamento = SemChaves); forward; 151 | function WriteDecls(Decl: TPasDeclarations; Indent: String; IsClosure: Boolean = False): Boolean; forward; 152 | function WriteExpr(Expr: TPasExpr; RemoveCreate: Boolean = False): String; forward; 153 | 154 | function WriteList(Left: String; Lista: TPasExprArray; Right: String): String; 155 | var 156 | I: Integer; 157 | Expr: TPasExpr; 158 | BExpr: TBinaryExpr; 159 | begin 160 | Result := ''; 161 | Write(G, Left); 162 | for I := 0 to High(Lista) do 163 | begin 164 | Expr := Lista[I]; 165 | if (Expr is TBinaryExpr) and (Expr.Kind in [pekRange, pekSet]) then 166 | begin 167 | BExpr := TBinaryExpr(Expr); 168 | if BExpr.Left.Kind = pekNumber then 169 | Write(G, 'for (var n = ', WriteExpr(BExpr.Left), '; n <= ', WriteExpr(BExpr.Right), '; n++) n') 170 | else 171 | Write(G, 'for (var c = ', WriteExpr(BExpr.Left), '.codeUnitAt(0); c <= ', WriteExpr(BExpr.Right), '.codeUnitAt(0); c++) ' + 172 | 'String.fromCharCode(c)'); 173 | Write(G, IfThen(I <> High(Lista), ', ')); 174 | end 175 | else 176 | Write(G, WriteExpr(Expr), IfThen(I <> High(Lista), ', ')); 177 | end; 178 | Write(G, Right); 179 | end; 180 | 181 | function IsFuncsWithoutParams(Func: String): String; 182 | begin 183 | Result := IfThen(Pos('"' + UpperCase(Func) + '"', FuncsWithoutParams) = 0, '', '()'); 184 | end; 185 | 186 | function ConvertCharLiteral(Value: String): String; 187 | begin 188 | Result := '''\u00'; 189 | if Pos('$', Value) <> 0 then 190 | Result := Result + Copy(Value, 3, 2) + '''' 191 | else 192 | Result := Result + IntToHex(StrToInt(Copy(Value, 2, 3)), 2) + ''''; 193 | end; 194 | 195 | function ConvertPrefixToSufix(Value: String): String; 196 | const 197 | Map = 'length=length,trim=trim(),upcase=toUpperCase(),uppercase=toUpperCase(),lowercase=toLowerCase(),trimleft=trimLeft(),trimright=trimRight()'; 198 | begin 199 | // trim 200 | end; 201 | 202 | function WriteExpr(Expr: TPasExpr; RemoveCreate: Boolean = False): String; 203 | var 204 | I: Integer; 205 | GetOp: array[TExprOpCode] of String = ('..', ' + ', ' - ', ' * ', ' / ', ' ~/ ', ' % ', ' ** ', ' >> ', ' << ', '!', ' && ', ' || ', 206 | ' ^ ', ' == ', ' != ', ' < ', ' > ', ' <= ', ' >= ', '.contains(', ' is ', ' as ', '.difference(', '', '', '', '.'); 207 | DartBool: array[Boolean] of String = ('false', 'true'); 208 | CompleteEnum, Member: String; 209 | begin 210 | Result := ''; 211 | if not Assigned(Expr) then Exit; 212 | if Expr is TBinaryExpr then 213 | with TBinaryExpr(Expr) do 214 | if (OpCode = eopSubIdent) and (Right is TParamsExpr) and (Upcase(TPrimitiveExpr(TParamsExpr(Right).Value).Value) = 'CREATE') then 215 | Write(G, WriteExpr(Left), WriteExpr(Right, True)) 216 | else 217 | case OpCode of 218 | eopIs : Write(G, WriteExpr(Left), GetOp[OpCode], ConvertClassName(TPrimitiveExpr(Right).Value)); 219 | eopIn : Write(G, WriteExpr(Right), '.contains(', WriteExpr(Left), ')'); 220 | else 221 | if Left is TInheritedExpr then 222 | Write(G, 'super', WriteExpr(Right, true)) 223 | else 224 | begin 225 | if (Left is TBinaryExpr) and (TBinaryExpr(Left).OpCode in ([eopAdd..eopAs] - [OpCode])) then 226 | Write(G, '(', WriteExpr(Left), ')') 227 | else 228 | Write(G, WriteExpr(Left)); 229 | if (Right is TPrimitiveExpr) and (TPrimitiveExpr(Right).Kind = pekIdent) and (OpCode = eopSubIdent) and 230 | (LowerCase(TPrimitiveExpr(Right).Value) = 'create') then 231 | begin 232 | Write(G, '()'); 233 | Exit; 234 | end; 235 | Write(G, GetOp[OpCode]); 236 | if (Right is TBinaryExpr) and (TBinaryExpr(Right).OpCode in ([eopAdd..eopAs] - [OpCode])) then 237 | Write(G, '(', WriteExpr(Right), ')') 238 | else 239 | Write(G, WriteExpr(Right)); 240 | end; 241 | end 242 | else 243 | if Expr is TUnaryExpr then 244 | if (Expr.Opcode = eopNot) and not(TUnaryExpr(Expr).Operand is TPrimitiveExpr) then 245 | Write(G, GetOp[Expr.OpCode], '(', WriteExpr(TUnaryExpr(Expr).Operand), ')') 246 | else 247 | Write(G, Trim(GetOp[Expr.OpCode]), WriteExpr(TUnaryExpr(Expr).Operand)) 248 | else 249 | if Expr is TPrimitiveExpr then 250 | with TPrimitiveExpr(Expr) do 251 | begin 252 | Member := ConvertMember(Value); 253 | case Kind of 254 | pekNumber: Value := ReplaceText(Value, '$', '0x'); 255 | pekString: 256 | case Value[1] of 257 | '#': Value := ConvertCharLiteral(Value); 258 | '''': 259 | if Value <> '''''' then 260 | begin 261 | Value := ReplaceText(Value, '\', '\\'); 262 | Value := ReplaceText(Value, '%s', '$s'); 263 | Value := ReplaceText(Value, '%d', '$d'); 264 | Value := '''' + ReplaceText(Copy(Value, 2, Length(Value) - 2), '''''', '"') + ''''; 265 | end; 266 | '^': Value := '''\u' + (Ord(Value[2]) - Ord('@')).ToHexString(4) + ''''; 267 | end; 268 | pekIdent: 269 | begin 270 | CompleteEnum := EnumTypes.Values[Value]; 271 | if CompleteEnum <> '' then 272 | begin 273 | Write(G, CompleteEnum + '.' + Member); 274 | Exit; 275 | end; 276 | if RemoveCreate then 277 | if Member = 'create' then 278 | begin 279 | Write(G, '()'); 280 | Exit; 281 | end 282 | else 283 | Write(G, '.'); 284 | end; 285 | end; 286 | Write(G, ConvertType(Member, False), IsFuncsWithoutParams(Value)) 287 | end 288 | else 289 | if Expr is TBoolConstExpr then 290 | Write(G, DartBool[TBoolConstExpr(Expr).Value]) 291 | else 292 | if Expr is TNilExpr then 293 | Write(G, 'null') 294 | else 295 | if Expr is TInheritedExpr then 296 | Write(G, 'super()') 297 | else 298 | if Expr is TSelfExpr then 299 | Write(G, 'this') 300 | else 301 | if Expr is TParamsExpr then //Writeln(G, param1,param2,..,paramn); 302 | with TParamsExpr(Expr) do 303 | case Kind of 304 | pekFuncParams: 305 | if RemoveCreate then 306 | WriteList('(', Params, ')') 307 | else 308 | if (Length(Params) = 1) and (Value.Kind = pekIdent) then 309 | if IsClassName(TPrimitiveExpr(Value).Value) then 310 | WriteList('(', Params, ' as ' + ConvertClassName(TPrimitiveExpr(Value).Value) + ')') 311 | else 312 | if ConvertMember(TPrimitiveExpr(Value).Value)[1] in ['-', '+'] then 313 | Write(G, WriteExpr(Params[0]), ConvertMember(TPrimitiveExpr(Value).Value)) 314 | else 315 | WriteList(WriteExpr(Value) + '(', Params, ')') 316 | else 317 | WriteList(WriteExpr(Value) + '(', Params, ')'); 318 | pekSet: 319 | WriteList(WriteExpr(Value) + '{', Params, '}'); 320 | else 321 | WriteList(WriteExpr(Value) + '[', Params, ']') 322 | end 323 | else 324 | if Expr is TArrayValues then //const AnArrayConst: Array[1..3] of Integer = (1,2,3); 325 | with TArrayValues(Expr) do 326 | WriteList('[', Values, ']') 327 | else 328 | if Expr is TRecordValues then 329 | with TRecordValues(Expr) do 330 | begin 331 | Write(G, '{'); 332 | for I := 0 to High(Fields) do 333 | with TRecordValuesItem(Fields[I]) do 334 | Write(G, Name, ': ', WriteExpr(ValueExp), IfThen(I <> High(Fields), ',')); 335 | Write(G, '}'); 336 | end 337 | else 338 | Writeln(G, 'Unknown expression: ', Expr.ClassName); 339 | end; 340 | 341 | procedure WriteCommandBlock(Comando: TPasImplBlock; Indent: String; Prefixo: String; Adicional: String = ''; Fechamento: TFechamento = ComChaves); 342 | begin 343 | if Assigned(Comando) then 344 | begin 345 | Write(G, Indent, Prefixo); 346 | WriteBlock(TPasImplBlock(Comando), Indent, Adicional, Fechamento); 347 | end; 348 | end; 349 | 350 | function Explode(Delimitador: Char; const Texto: String): TStringList; 351 | begin 352 | Result := TStringList.Create; 353 | with Result do 354 | begin 355 | StrictDelimiter := True; 356 | Delimiter := Delimitador; 357 | QuoteChar := #0; 358 | NameValueSeparator := #0; 359 | Sorted := False; 360 | CaseSensitive := False; 361 | Duplicates := dupAccept; 362 | if Texto = '' then 363 | Clear 364 | else 365 | DelimitedText := Texto; 366 | end; 367 | end; 368 | 369 | function WriteByRefFunction(Func: TPasExpr; Variable, Indent: String): Boolean; 370 | var 371 | Decl, Atrib: String; 372 | I, P: Integer; 373 | Args, FuncParams: TStringList; 374 | IfSmt: Boolean; 375 | FuncParam: TPasExpr; 376 | begin 377 | Result := False; 378 | FuncParam := Func; 379 | if Func is TBinaryExpr then 380 | with TBinaryExpr(Func) do 381 | if (OpCode = eopSubIdent) and (Right is TParamsExpr) then 382 | FuncParam := Right; 383 | if FuncParam is TParamsExpr then 384 | with TParamsExpr(FuncParam) do 385 | begin 386 | Decl := TPrimitiveExpr(Value).Value + IntToStr(High(Params) + 1); 387 | I := FuncWithByRefs.IndexOf(Decl); 388 | if I >= 0 then 389 | begin 390 | Args := TStringList(FuncWithByRefs.Objects[I]); 391 | Decl := GetDeclaration(False); 392 | Decl := Copy(Decl, 2, Length(Decl) - 2); 393 | FuncParams := Explode(',', Decl); 394 | Atrib := ''; 395 | I := 0; 396 | if Variable <> '' then 397 | begin 398 | I := 1; 399 | Atrib := Variable + ', '; 400 | end; 401 | for I := I to Args.Count - 1 do 402 | begin 403 | P := PtrInt(Args.Objects[I]); 404 | if (P < FuncParams.Count) and IsValidIdent(Trim(FuncParams[P])) then 405 | Atrib := Atrib + Indent + ConvertMember(Trim(FuncParams[P])) + ' = ret[' + IntToStr(I) + '];' + LF 406 | else 407 | Continue; 408 | end; 409 | IfSmt := Pos('return', Variable) = 1; 410 | if IfSmt then 411 | Writeln(G, Indent, 'bool ', Variable, LF); 412 | Writeln(G, Indent, 'var ret = ', WriteExpr(Func), ';'); 413 | Write(G, Atrib); 414 | if IfSmt then 415 | Write(G, Indent, 'if (', Variable, ')'); 416 | Result := True; 417 | end; 418 | end; 419 | end; 420 | 421 | procedure WriteSmt(Smt: TPasImplStatement; Indent: String); 422 | var 423 | I: Integer; 424 | ExceptObj: TPasExpr; 425 | begin 426 | if Smt is TPasImplSimple then 427 | with TPasImplSimple(Smt) do 428 | begin 429 | if Expr is TBinaryExpr then 430 | begin 431 | if (TBinaryExpr(Expr).Right is TPrimitiveExpr) and 432 | AnsiEndsText('free', TPrimitiveExpr(TBinaryExpr(Expr).Right).Value) then 433 | Exit; 434 | end 435 | else 436 | if (Expr is TParamsExpr) and (TPasExpr(TParamsExpr(Expr).Value) is TPrimitiveExpr) and 437 | AnsiContainsText('FreeAndNil', TPrimitiveExpr(TPasExpr(TParamsExpr(Expr).Value)).Value) then 438 | Exit; 439 | if not WriteByRefFunction(Expr, '', Indent) then 440 | Writeln(G, Indent, WriteExpr(Expr), ';') 441 | end 442 | else 443 | if Smt is TPasImplAssign then 444 | with TPasImplAssign(Smt) do 445 | begin 446 | if ((Left is TPrimitiveExpr) and not WriteByRefFunction(Right, ConvertMember(TPrimitiveExpr(Left).Value), Indent)) or 447 | not(Left is TPrimitiveExpr) then 448 | Writeln(G, Indent, WriteExpr(Left), ' = ', WriteExpr(Right), ';'); 449 | end 450 | else 451 | if Smt is TPasImplCaseStatement then 452 | with TPasImplCaseStatement(Smt) do 453 | begin 454 | Write(G, Indent); 455 | for I := 0 to Expressions.Count - 1 do 456 | Write(G, 'case ', WriteExpr(TPasExpr(Expressions[I])), ': '); 457 | WriteImplElement(Body, Indent + TAB, LF, SemChaves); 458 | Writeln(G, Indent + TAB, 'break;'); 459 | end 460 | else 461 | if Smt is TPasImplWithDo then 462 | with TPasImplWithDo(Smt) do 463 | begin 464 | Write(G, Indent); 465 | for I := 0 to Expressions.Count - 1 do 466 | Write(G, WriteExpr(TPasExpr(Expressions[I])), '.with', IfThen(I < Expressions.Count - 1, ' { ')); //**** 467 | WriteImplElement(Body, Indent, '', ComChavesSemSalto); 468 | Writeln(G, IfThen(Expressions.Count > 1, StringOfChar('}', Expressions.Count - 1))); 469 | end 470 | else 471 | if Smt is TPasImplWhileDo then 472 | with TPasImplWhileDo(Smt) do 473 | begin 474 | Write(G, Indent, 'while (', WriteExpr(ConditionExpr), ')'); 475 | WriteImplElement(Body, Indent + TAB, '', ComChaves); 476 | end 477 | else 478 | if Smt is TPasImplExceptOn then 479 | with TPasImplExceptOn(Smt) do 480 | begin 481 | Write(G, Indent, 'on ', ConvertType(TypeName), ' catch (', ConvertMember(VariableName), ')'); 482 | WriteImplElement(Body, Indent, IfThen(TPasImplElement(Body) is TPasImplRaise, 'throw '), ComChaves) 483 | end 484 | else 485 | if Smt is TPasImplForLoop then 486 | with TPasImplForLoop(Smt) do 487 | begin 488 | if LoopType = ltIn then 489 | Write(G, Indent, 'for (var ', WriteExpr(VariableName), ' in ', WriteExpr(StartExpr), ')') 490 | else 491 | begin 492 | Write(G, Indent, 'for (var ', WriteExpr(VariableName), ' = '); 493 | WriteExpr(StartExpr); 494 | Write(G, '; ', WriteExpr(VariableName), IfThen(Down, ' >= ', ' <= ')); 495 | WriteExpr(EndExpr); 496 | Write(G, '; ', WriteExpr(VariableName), IfThen(Down, '--', '++'), ')'); 497 | end; 498 | WriteImplElement(Body, Indent, '', ComChaves); 499 | end 500 | else 501 | if Smt is TPasImplRaise then 502 | begin 503 | ExceptObj := TPasImplRaise(Smt).ExceptObject; 504 | if ExceptObj = nil then 505 | Writeln(G, Indent, 'rethrow;') 506 | else 507 | Writeln(G, Indent, 'throw ', WriteExpr(ExceptObj), ';') 508 | end 509 | else 510 | WriteBlock(Smt, Indent + TAB); 511 | end; 512 | 513 | procedure WriteImplElement(Comando: TPasImplElement; Indent: String; Aditional: String = ''; Fechamento: TFechamento = SemChaves); 514 | begin 515 | if not Assigned(Comando) then 516 | begin 517 | Writeln(G, ' ;'); 518 | Exit; 519 | end; 520 | Write(G, Aditional); 521 | if Fechamento in [ComChaves, ComChavesSemSalto] then 522 | begin 523 | Writeln(G, ' {'); 524 | Indent := Indent + TAB; 525 | end; 526 | if Comando is TPasImplStatement then 527 | WriteSmt(TPasImplStatement(Comando), Indent) 528 | else 529 | if Comando is TPasImplIfElse then 530 | with TPasImplIfElse(Comando) do 531 | begin 532 | if not WriteByRefFunction(ConditionExpr, 'return' + IntToStr(SourceLinenumber), Indent) then 533 | Write(G, Indent, 'if (', WriteExpr(ConditionExpr), ')'); 534 | WriteImplElement(IfBranch, Indent, '', ComChavesSemSalto); 535 | if Assigned(ElseBranch) then 536 | WriteImplElement(ElseBranch, Indent, ' else', ComChaves) 537 | else 538 | Writeln(G); 539 | end 540 | else 541 | if Comando is TPasImplCaseOf then 542 | begin 543 | Write(G, Indent, 'switch (', WriteExpr(TPasImplCaseOf(Comando).CaseExpr), ')'); 544 | WriteBlock(TPasImplCaseOf(Comando), Indent); 545 | end 546 | else 547 | if Comando is TPasImplCaseElse then 548 | begin 549 | Writeln(G, Indent, 'default:'); 550 | WriteBlock(TPasImplCaseOf(Comando), Indent + TAB, '', SemChaves) 551 | end 552 | else 553 | if Comando is TPasImplRepeatUntil then 554 | begin 555 | WriteCommandBlock(TPasImplBlock(Comando), Indent, 'do', '', ComChavesSemSalto); 556 | Writeln(G, ' while (!', WriteExpr(TPasImplRepeatUntil(Comando).ConditionExpr), ');') 557 | end 558 | else 559 | if Comando is TPasImplTry then 560 | with TPasImplTry(Comando) do 561 | begin 562 | Write(G, Indent, 'try'); 563 | WriteBlock(TPasImplBlock(Comando), Indent, '', ComChavesSemSalto); 564 | WriteImplElement(TPasImplElement(FinallyExcept), Indent); 565 | if Assigned(ElseBranch) then 566 | WriteImplElement(TPasImplElement(ElseBranch), Indent); 567 | end 568 | else 569 | if Comando is TPasImplTryFinally then 570 | begin 571 | Write(G, ' finally {'); 572 | WriteCommandBlock(TPasImplBlock(Comando), Indent, LF, '', SoFinal) 573 | end 574 | else 575 | if (Comando is TPasImplTryExcept) or (Comando is TPasImplTryExceptElse) then 576 | begin 577 | Write(G, ' catch (e) {'); 578 | WriteCommandBlock(TPasImplBlock(Comando), Indent, LF, '', SoFinal) 579 | end 580 | else 581 | if Comando is TPasImplLabelMark then 582 | Write(G, Indent, TPasImplLabelMark(Comando).LabelId, ':') 583 | else 584 | if Comando is TPasImplBlock then 585 | WriteBlock(TPasImplBlock(Comando), Indent, '', TFechamento(IfThen(Fechamento in [ComChaves, ComChavesSemSalto], Byte(SemChaves), Byte(Fechamento)))); 586 | if Fechamento in [ComChaves, SoFinal, ComChavesSemSalto] then 587 | Write(G, Copy(Indent, 1, Length(Indent) - Length(TAB)), '}', IfThen(Fechamento <> ComChavesSemSalto, LF)); 588 | end; 589 | 590 | procedure WriteBlock(Block: TPasImplBlock; Indent: String; Aditional: String = ''; Fechamento: TFechamento = ComChaves); 591 | var 592 | I: Integer; 593 | begin 594 | if not Assigned(Block) then Exit; 595 | case Fechamento of 596 | ComChaves, SoInicio, ComChavesSemSalto: Writeln(G, ' {'); 597 | SemChaves: Indent := Copy(Indent, 1, Length(Indent) - Length(TAB)); 598 | end; 599 | with Block do 600 | if Assigned(Elements) then 601 | if Block is TPasImplBlock then 602 | for I := 0 to Elements.Count - 1 do 603 | WriteImplElement(TPasImplElement(Elements[I]), Indent + TAB); 604 | if Aditional <> '' then 605 | Writeln(G, Indent + TAB, Aditional); 606 | case Fechamento of 607 | ComChaves, SoFinal: Writeln(G, Indent, '}'); 608 | ComChavesSemSalto: Write(G, Indent, '}'); 609 | end; 610 | end; 611 | 612 | function GetArrayTypePos(ArrayType: TPasArrayType): String; 613 | begin 614 | with ArrayType do 615 | if ElType = nil then 616 | Result := 'List' 617 | else 618 | Result := DupeString('List<', High(Ranges) + 1) + ConvertType(ElType.Name) + DupeString('>', High(Ranges) + 1) 619 | end; 620 | 621 | procedure WriteArrayTypePre(ArrayType: TPasArrayType); 622 | begin 623 | Write(G, GetArrayTypePos(ArrayType)); 624 | Write(G, ' '); 625 | end; 626 | 627 | procedure WriteVar(Variavel: TPasVariable; Indent: String); forward; 628 | 629 | procedure WriteRecord(Registro: TPasRecordType; Indent: String); 630 | var 631 | I, J: Integer; 632 | begin 633 | with Registro do 634 | begin 635 | Write(G, Indent, 'class ' + ConvertClassName(Name) + ' {'); 636 | for I := 0 to Members.Count - 1 do 637 | WriteVar(TPasVariable(Members[I]), LF + Indent + TAB); 638 | WriteVar(TPasVariable(VariantEl), Indent + TAB); 639 | Writeln(G, LF, '}', LF); 640 | if Assigned(Variants) then 641 | for I := 0 to Variants.Count - 1 do 642 | with TPasVariant(Variants[I]) do 643 | begin 644 | Writeln(G, LF, Indent, 'class ' + ConvertClassName(Name) + ' extends ' + ConvertClassName(Registro.Name) + '{'); 645 | with TPasRecordType(Members) do 646 | for J := 0 to Members.Count - 1 do 647 | WriteVar(TPasVariable(Members[I]), Indent + TAB); 648 | Writeln(G, LF, '}', LF); 649 | end; 650 | end 651 | end; 652 | 653 | function WritePropertyType(VarType: TPasType): String; 654 | begin 655 | Result := ''; 656 | if Assigned(VarType) then 657 | if VarType is TPasArrayType then 658 | Result := GetArrayTypePos(TPasArrayType(VarType)) 659 | else 660 | if VarType is TPasSetType then 661 | Result := 'Set<' + ConvertType(ConvertClassName(TPasSetType(VarType).EnumType.Name), True) + '>' 662 | else 663 | if VarType is TPasPointerType then 664 | Result := 'Object' 665 | else 666 | Result := ConvertType(VarType.Name); 667 | end; 668 | 669 | procedure WriteVar(Variavel: TPasVariable; Indent: String); 670 | begin 671 | if Assigned(Variavel) then 672 | with Variavel do 673 | begin 674 | Write(G, Indent); 675 | if Assigned(VarType) and not(Variavel is TPasConst) then 676 | begin 677 | if VarType is TPasArrayType then 678 | begin 679 | if Assigned(Expr) then 680 | begin 681 | WriteArrayTypePre(TPasArrayType(VarType)); 682 | Write(G, ConvertMember(Name), ' = ', WriteExpr(Expr)); 683 | end 684 | else 685 | Write(G, 'var ', ConvertMember(Name), ' = ', GetArrayTypePos(TPasArrayType(VarType)), '()'); 686 | Write(G, ';'); 687 | Exit; 688 | end 689 | else 690 | if VarType is TPasSetType then 691 | Write(G, 'Set<', ConvertType(ConvertClassName(TPasSetType(Variavel.VarType).EnumType.Name), True) + '>') 692 | else 693 | if VarType is TPasPointerType then 694 | Write(G, 'Object') 695 | else 696 | if VarType is TPasRecordType then 697 | WriteRecord(TPasRecordType(VarType), Indent) 698 | else 699 | Write(G, ConvertType(TPasType(Variavel.VarType).Name)); 700 | Write(G, ' ', ConvertMember(Name)); 701 | end 702 | else 703 | Write(G, 'const ', ConvertMember(Name)); // const 704 | if Assigned(Expr) then // const AnArrayConst : Array[1..3] of Integer = (1,2,3); 705 | Write(G, ' = ', WriteExpr(Expr)); 706 | Write(G, ';'); 707 | end; 708 | end; 709 | 710 | procedure WriteTypes(Elemento: TPasElement; Indent: String); 711 | var 712 | I: Integer; 713 | EnumType, EnumName: String; 714 | begin 715 | if Elemento is TPasArrayType then 716 | AliasTypes.Add(Elemento.Name + '=' + GetArrayTypePos(TPasArrayType(Elemento))) 717 | else 718 | if Elemento is TPasEnumType then 719 | begin 720 | EnumType := ConvertClassName(Elemento.Name); 721 | Writeln(G, Indent, 'enum ' + EnumType + ' {'); 722 | with TPasEnumType(Elemento) do 723 | for I := 0 to Values.Count - 1 do 724 | begin 725 | EnumName := ConvertMember(TPasEnumValue(Values[I]).Name); 726 | EnumTypes.Add(EnumName + '=' + EnumType); 727 | Writeln(G, Indent, TAB, EnumName, IfThen(I < (Values.Count - 1), ', ')); 728 | end; 729 | Writeln(G, Indent + '}', LF); 730 | end 731 | else 732 | if Elemento is TPasFileType then 733 | AliasTypes.Add(Elemento.Name + '=File') 734 | else 735 | if Elemento is TPasProcedureType then 736 | AliasTypes.Add(Elemento.Name + '=Function') 737 | else 738 | if Elemento is TPasPointerType then 739 | AliasTypes.Add(Elemento.Name + '=Object') 740 | else 741 | if Elemento is TPasRangeType then 742 | with TPasRangeType(Elemento) do 743 | AliasTypes.Add(Name + '=int') 744 | else 745 | if Elemento is TPasRecordType then 746 | WriteRecord(TPasRecordType(Elemento), Indent) 747 | else 748 | if Elemento is TPasSetType then 749 | AliasTypes.Add(Elemento.Name + '=Set<' + ConvertType(ConvertClassName(TPasSetType(Elemento).EnumType.Name), True) + '>') 750 | else 751 | if Elemento is TPasClassOfType then 752 | AliasTypes.Add(Elemento.Name + '=class') 753 | else 754 | if Elemento is TPasAliasType then 755 | AliasTypes.Add(Elemento.Name + '=' + ConvertType(TPasAliasType(Elemento).DestType.Name)) 756 | else 757 | Writeln(G, Indent, 'Unknown type: ', Elemento.Name, ' ', Elemento.Classname); 758 | end; 759 | 760 | function FindProcBody(Proc: TPasProcedure): TProcedureBody; 761 | var 762 | Secao, Elemento: TPasElement; 763 | I: Integer; 764 | begin 765 | Result := Proc.Body; 766 | if Assigned(Proc.Body) then Exit; 767 | Secao := Proc.Parent.Parent; 768 | if not(Secao is TImplementationSection) then 769 | if TPasModule(Secao.Parent) <> nil then 770 | Secao := TPasModule(Secao.Parent).ImplementationSection; 771 | if Secao is TImplementationSection then 772 | with TPasDeclarations(Secao) do 773 | for I := 0 to Declarations.Count - 1 do 774 | begin 775 | Elemento := TPasElement(Declarations[I]); 776 | if Elemento is TPasProcedure then 777 | with TPasProcedure(Elemento) do 778 | if (Name + ProcType.GetDeclaration(True)) = (Proc.Parent.Name + '.' + Proc.Name + Proc.Proctype.GetDeclaration(True)) then 779 | begin 780 | Result := Body; 781 | Exit; 782 | end; 783 | end; 784 | end; 785 | 786 | procedure WriteProcParams(Args: TFPList; IsClosure: Boolean = False); 787 | var 788 | I : Integer; 789 | Optional: Boolean = false; 790 | begin 791 | if not IsClosure then 792 | Write(G, '('); 793 | if Assigned(Args) then 794 | for I := 0 to Args.Count - 1 do 795 | with TPasArgument(Args[I]) do 796 | begin 797 | if (Value <> '') and not Optional then 798 | begin 799 | Optional := true; 800 | Write(G, '['); 801 | end; 802 | if ArgType is TPasArrayType then 803 | WriteArrayTypePre(TPasArrayType(ArgType)) 804 | else 805 | Write(G, ConvertType(ArgType.Name) + ' '); 806 | Write(G, ConvertMember(Name)); 807 | Write(G, IfThen(Value <> '', ' = ' + Value)); 808 | Write(G, IfThen(I < (Args.Count - 1), ', ')); 809 | end; 810 | Write(G, IfThen(Optional, ']'), IfThen(IsClosure, ' =>', ')')); 811 | end; 812 | 813 | function GetByRefArgs(Args: TFPList; InFunction: Boolean): TStringList; 814 | var 815 | I: PtrInt; 816 | begin 817 | Result := TStringList.Create; 818 | for I := 0 to Args.Count - 1 do 819 | with TPasArgument(Args[I]) do 820 | if (Access in [argVar, argOut]) and TypeIsPrimitive(ArgType.Name) then 821 | Result.AddObject(ConvertMember(Name), TObject(I)); 822 | if (Result.Count <> 0) and InFunction then 823 | Result.InsertObject(0, 'result', TObject(Pointer(-1))); 824 | end; 825 | 826 | procedure WriteProcBody(Proc: TPasProcedure; Indent: String; FuncType: String; IsClosure: Boolean); 827 | var 828 | Returns: String; 829 | begin 830 | Proc.Body := FindProcBody(Proc); 831 | if ByRefArgs.Count > 0 then 832 | begin 833 | Proc.CustomData := ByRefArgs; 834 | FuncWithByRefs.AddObject(Proc.Name + IntToStr(Proc.ProcType.Args.Count), ByRefArgs); 835 | end; 836 | if Assigned(Proc.Body) then 837 | begin 838 | Writeln(G, IfThen(IsClosure, '', ' {')); 839 | if InFunction then 840 | Writeln(G, Indent + TAB, FuncType, ' result;'); 841 | if not WriteDecls(Proc.Body, Indent + TAB, True) and InFunction then 842 | Writeln(G); 843 | Returns := ''; 844 | if InFunction or (ByRefArgs.Count > 0) then 845 | Returns := 'return ' + IfThen(ByRefArgs.Count > 0, '[' + ListToStr(ByRefArgs) + ']', 'result') + ';'; 846 | WriteBlock(TPasImplBlock(Proc.Body.Body), Indent, Returns, SoFinal); 847 | end 848 | else 849 | Writeln(G, ';'); 850 | 851 | end; 852 | 853 | procedure WriteClosure(Proc: TPasProcedure; Indent: String); 854 | var 855 | FuncType: String; 856 | begin 857 | if Assigned(Proc) then 858 | begin 859 | Write(G, Indent, 'Function'); 860 | InFunction := Proc.ProcType is TPasFunctionType; 861 | ByRefArgs := GetByRefArgs(Proc.ProcType.Args, InFunction); 862 | if InFunction then 863 | FuncType := '<' + ConvertType(TPasFunctionType(Proc.ProcType).ResultEl.ResultType.Name) + '>' 864 | else 865 | FuncType := ''; 866 | Write(G, IfThen(ByRefArgs.Count > 0, '<List>', FuncType) + ' ' + ConvertMember(Proc.Name), ' = {'); 867 | WriteProcParams(Proc.ProcType.Args, True); 868 | WriteProcBody(Proc, Indent, FuncType, True); 869 | end; 870 | InFunction := False; 871 | end; 872 | 873 | function WriteProcedure(Proc: TPasProcedure; Indent: String; Visibility: String = ''): Boolean; 874 | var 875 | FuncType: String; 876 | begin 877 | if Assigned(Proc) and not Proc.IsForward then 878 | begin 879 | Result := true; 880 | if Proc.IsOverride then 881 | Write(G, Indent, '@override', LF); 882 | Write(G, Indent, IfThen((Proc is TPasClassProcedure) or (Proc is TPasClassFunction), 'static ')); 883 | InFunction := Proc.ProcType is TPasFunctionType; 884 | ByRefArgs := GetByRefArgs(Proc.ProcType.Args, InFunction); 885 | if InFunction then 886 | FuncType := ConvertType(TPasFunctionType(Proc.ProcType).ResultEl.ResultType.Name) 887 | else 888 | FuncType := 'void'; 889 | Write(G, IfThen((Proc is TPasConstructor) or (TPasElement(Proc) is TPasConstructorImpl), ConvertClassName(Proc.Parent.Name), 890 | IfThen(ByRefArgs.Count > 0, '', FuncType + ' ') + Visibility + ConvertMember(Proc.Name))); 891 | WriteProcParams(Proc.ProcType.Args); 892 | WriteProcBody(Proc, Indent, FuncType, False); 893 | end 894 | else 895 | Result := false; 896 | InFunction := False; 897 | end; 898 | 899 | procedure GetFuncsWithoutParams(Members: TFPList); 900 | var 901 | I: Integer; 902 | Elemento: TPasElement; 903 | begin 904 | for I := 0 to Members.Count - 1 do 905 | begin 906 | Elemento := TPasElement(Members[I]); 907 | if Elemento is TPasFunction then 908 | with TPasFunction(Elemento) do 909 | if not Assigned(ProcType.Args) or (ProcType.Args.Count = 0) then 910 | FuncsWithoutParams := FuncsWithoutParams + UpperCase(Name) + '"'; 911 | end; 912 | end; 913 | 914 | function HasAbstractMethod(Class_: TPasClassType): Boolean; 915 | var 916 | I: Integer; 917 | Elemento: TPasElement; 918 | begin 919 | Result := false; 920 | with Class_ do 921 | for I := 0 to Members.Count - 1 do 922 | begin 923 | Elemento := TPasElement(Members[I]); 924 | if (Elemento is TPasProcedure) and TPasProcedure(Elemento).IsAbstract then 925 | begin 926 | Result := true; 927 | Exit; 928 | end; 929 | end; 930 | end; 931 | 932 | procedure WriteClass(Class_: TPasClassType; Indent: String); 933 | var 934 | GetVisibility: array[TPasMemberVisibility] of String = ('', '_', '', '', '', '', '_', ''); 935 | I: Integer; 936 | Elemento: TPasElement; 937 | Prefix: String; 938 | begin 939 | if Assigned(Class_) and not Class_.IsForward then 940 | with Class_ do 941 | begin 942 | Write(G, DocComment); 943 | Write(G, Indent, IfThen((ObjKind = okInterface) or IsAbstract or HasAbstractMethod(Class_), 'abstract class ', 'class '), ConvertClassName(Name)); 944 | if Assigned(AncestorType) and (AncestorType.ElementTypeName <> '') then 945 | Write(G, ' extends ', ConvertClassName(AncestorType.Name)); 946 | if Assigned(Interfaces) and (Interfaces.Count > 0) then 947 | begin 948 | Write(G, ' implements ', ConvertClassName(AncestorType.Name)); 949 | for I := 0 to Interfaces.Count - 1 do 950 | begin 951 | Write(G, TPasElement(Interfaces[I]).Name); 952 | Write(G, IfThen(I <> (Interfaces.Count - 1), ',')) 953 | end; 954 | end; 955 | Writeln(G, ' {'); 956 | GetFuncsWithoutParams(Members); 957 | for I := 0 to Members.Count - 1 do 958 | begin 959 | Elemento := TPasElement(Members[I]); 960 | if Elemento.Name = '' then Continue; 961 | if (I <> 0) and (TPasElement(Members[I - 1]) is TPasVariable) and not (Elemento is TPasVariable) then 962 | Writeln(G); 963 | Write(G, Elemento.DocComment); 964 | Prefix := Indent + TAB; 965 | if Elemento is TPasProcedure then 966 | WriteProcedure(TPasProcedure(Elemento), Indent + TAB, GetVisibility[Elemento.Visibility]) 967 | else 968 | begin 969 | Elemento.Name := ConvertMember(Elemento.Name); 970 | if Elemento is TPasProperty then 971 | with TPasProperty(Elemento) do 972 | begin 973 | if ReadAccessor <> nil then 974 | Write(G, Prefix, WritePropertyType(VarType), ' get ', CamelCase(Name), ' => ', WriteExpr(ReadAccessor), ';'); 975 | if WriteAccessor <> nil then 976 | begin 977 | if ReadAccessor <> nil then Writeln(G); 978 | Write(G, Prefix, 'set ', CamelCase(Name), '(', WritePropertyType(VarType), ' value) => ', ConvertMember(WriteAccessorName), ' = value;'); 979 | end; 980 | end 981 | else 982 | if Elemento is TPasVariable then 983 | WriteVar(TPasVariable(Elemento), Prefix) 984 | else 985 | Writeln(G, 'Unknown declaration in class/interface: ', Elemento.Name); 986 | end; 987 | Writeln(G); 988 | end; 989 | Writeln(G, Indent, '}'); 990 | end; 991 | end; 992 | 993 | procedure WriteResString(Variavel: TPasResString); 994 | begin 995 | if Assigned(Variavel) then 996 | with Variavel do 997 | Write(G, 'const ', ConvertMember(Name), ' = ', WriteExpr(Expr), ';'); 998 | end; 999 | 1000 | function WriteDecls(Decl: TPasDeclarations; Indent: String; IsClosure: Boolean = False): Boolean; 1001 | var 1002 | I: Integer; 1003 | Elemento, ElementoProx: TPasElement; 1004 | begin 1005 | Result := False; 1006 | if Assigned(Decl) then 1007 | begin 1008 | Elemento := TPasElement(Decl); 1009 | if Elemento is TPasSection then // TInterfaceSection, TImplementationSection or TProgramSection 1010 | with TPasSection(Elemento) do 1011 | begin 1012 | for I := 0 to UsesList.Count - 1 do 1013 | case UpCase(TPasElement(UsesList[I]).Name) of 1014 | 'SYSTEM', 'STRUTILS', 'CLASSES', 'LCLTYPE' : ; 1015 | 'SYSUTILS': Writeln(G, 'import ''dart:io'';'); 1016 | 'CONTNRS' : Writeln(G, 'import ''dart:collection'';'); 1017 | 'MATH' : Writeln(G, 'import ''dart:math'';'); 1018 | else 1019 | Writeln(G, 'import ''', TPasElement(UsesList[I]).Name, ''';'); 1020 | end; 1021 | if UsesList.Count <> 0 then 1022 | Writeln(G); 1023 | end; 1024 | if Assigned(Decl.Declarations) then 1025 | begin 1026 | for I := 0 to Decl.Declarations.Count - 1 do 1027 | begin 1028 | Flush(G); 1029 | Elemento := TPasElement(Decl.Declarations[I]); 1030 | if Elemento.DocComment <> '' then 1031 | Writeln(G, '//', Elemento.DocComment); 1032 | if Elemento is TPasConst then 1033 | WriteVar(TPasConst(Elemento), Indent) // static final <tipo> <const> = <value> 1034 | else 1035 | if Elemento is TPasResString then 1036 | WriteResString(TPasResString(Elemento)) 1037 | else 1038 | if Elemento is TPasVariable then 1039 | WriteVar(TPasVariable(Elemento), Indent) // <tipo> <const> = <value> 1040 | else 1041 | if Elemento is TPasClassType then 1042 | WriteClass(TPasClassType(Elemento), Indent) 1043 | else 1044 | if Elemento is TPasType then 1045 | begin 1046 | WriteTypes(TPasElement(Elemento), Indent); // def TAtribute = [1..7]; def Range = 1..7; e enums 1047 | Continue; 1048 | end 1049 | else 1050 | if Elemento is TPasProcedureBase then 1051 | begin 1052 | if Pos('.', TPasProcedureBase(Elemento).Name) <> 0 then 1053 | Continue 1054 | else 1055 | if IsClosure then 1056 | WriteClosure(TPasProcedure(Elemento), Indent) 1057 | else 1058 | if not WriteProcedure(TPasProcedure(Elemento), Indent) then 1059 | Continue; 1060 | end 1061 | else 1062 | Writeln(G, 'Unknown declaration: ', Elemento.Name); 1063 | Writeln(G); 1064 | if I < (Decl.Declarations.Count - 1) then 1065 | begin 1066 | ElementoProx := TPasElement(Decl.Declarations[I + 1]); 1067 | if ((Elemento is TPasVariable) or (Elemento is TPasResString)) and 1068 | not((ElementoProx is TPasVariable) or (ElementoProx is TPasResString)) then 1069 | Writeln(G); 1070 | end; 1071 | end; 1072 | Result := Decl.Declarations.Count <> 0; 1073 | if Result then 1074 | Writeln(G); 1075 | end; 1076 | end; 1077 | end; 1078 | 1079 | var 1080 | Modulo: TPasModule; 1081 | Tree: TPasTree; 1082 | 1083 | begin 1084 | AliasTypes := TStringList.Create; 1085 | EnumTypes := TStringList.Create; 1086 | FuncWithByRefs := TStringList.Create; 1087 | Tree := TPasTree.Create; 1088 | Tree.NeedComments := True; 1089 | try 1090 | Modulo := ParseSource(Tree, ParamStr(1) + ' -Sdelphi', 'WINDOWS', 'i386'); 1091 | except 1092 | on E: EParserError do 1093 | begin 1094 | Writeln(G, E.Message, ' line:', E.Row, ' column:', E.Column, ' file:', E.Filename); 1095 | Halt; 1096 | end; 1097 | end; 1098 | AssignFile(G, 'C:\trabalho\pas2dart\' + Modulo.Name + '.dart'); 1099 | Rewrite(G); 1100 | if Modulo is TPasProgram then 1101 | begin 1102 | WriteDecls(TPasProgram(Modulo).ProgramSection, ''); 1103 | WriteCommandBlock(Modulo.InitializationSection as TPasImplBlock, '', 'void main(List<String> args)', '', ComChaves); 1104 | end 1105 | else 1106 | begin 1107 | Writeln(G, 'library ', Modulo.Name, ';', LF); 1108 | WriteDecls(Modulo.InterfaceSection as TPasDeclarations, ''); 1109 | WriteDecls(Modulo.ImplementationSection as TPasDeclarations, ''); 1110 | WriteCommandBlock(Modulo.InitializationSection as TPasImplBlock, '', 'void initialization()'); 1111 | WriteCommandBlock(Modulo.FinalizationSection as TPasImplBlock, '', 'void finalization()'); 1112 | end; 1113 | AliasTypes.Free; 1114 | FuncWithByRefs.Free; 1115 | Close(G); 1116 | end. 1117 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # pas2dart 2 | Object Pascal (Free Pascal 3, Delphi 2007) to Dart (2.5) - Transpiler 3 | 4 | TODO: 5 | 6 | 1. ~~Convert properties (read/write) to get/set Dart style~~ 7 | 2. Convert 'with' statements, removing 'withs'... 8 | 3. Convert some usual string functions from infix (imperative) old style to postfix (OO) new style 9 | 4. Transpile multiple sources using 'uses' declaration 10 | 5. Create standard Dart project from lpr/dpr files 11 | 6. Create helper lib to emulate some Delphi functions in Dart converted app 12 | 7. Convert simple LCL/VCL forms to Flutter, using [Flutter for desktop](https://medium.com/flutter-community/flutter-for-desktop-create-and-run-a-desktop-application-ebeb1604f1e0) 13 | -------------------------------------------------------------------------------- /paswrite.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Component Library 3 | 4 | Pascal tree source file writer 5 | Copyright (c) 2003 by 6 | Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | 17 | {$mode objfpc} 18 | {$h+} 19 | {$inline on} 20 | 21 | unit PasWrite; 22 | 23 | interface 24 | 25 | uses StrUtils, SysUtils, Classes, PasTree; 26 | 27 | type 28 | EPasWriter = Class(Exception); 29 | 30 | { TPasWriter } 31 | TPasWriterOption = (woNoImplementation, // Do not create implementation code. 32 | woNoExternalClass, // Do not create classes as external 33 | woNoExternalVar, // Do not declare external variables as external. 34 | woNoExternalFunc, // Do not declare external functions as external. 35 | woAddLineNumber, // Prefix line with generated line numbers in comment 36 | woAddSourceLineNumber, // Prefix line with original source line numbers (when available) in comment 37 | woForwardClasses, // Add forward definitions for all classes 38 | woForceOverload // Force 'overload;' on overloads that are not marked as such. 39 | ); 40 | TPasWriterOptions = Set of TPasWriterOption; 41 | 42 | TPasWriter = class 43 | private 44 | FCurrentLineNumber : Integer; 45 | FCurrentLine : String; 46 | FExtraUnits: String; 47 | FForwardClasses: TStrings; 48 | FLineEnding: String; 49 | FLineNumberWidth: Integer; 50 | FOPtions: TPasWriterOptions; 51 | FStream: TStream; 52 | FIndentSize : Integer; 53 | IsStartOfLine: Boolean; 54 | FLineElement : TPasElement; 55 | FIndentStep, 56 | Indent, 57 | CurDeclSection: string; 58 | DeclSectionStack: TList; 59 | FInImplementation : Boolean; 60 | procedure SetForwardClasses(AValue: TStrings); 61 | procedure SetIndentSize(AValue: Integer); 62 | protected 63 | procedure PrepareDeclSectionInStruct(const ADeclSection: string); 64 | procedure MaybeSetLineElement(AElement: TPasElement); 65 | function GetExpr(E: TPasExpr): String; virtual; 66 | Function HasOption(aOption : TPasWriterOption) : Boolean; inline; 67 | Function NotOption(aOption : TPasWriterOption) : Boolean; inline; 68 | Function PostProcessLine(S : String) : String; virtual; 69 | Function GetLineNumberComment : String; virtual; 70 | Procedure ResetIndent; 71 | procedure IncIndent; 72 | procedure DecIndent; 73 | procedure IncDeclSectionLevel; 74 | procedure DecDeclSectionLevel; 75 | procedure PrepareDeclSection(const ADeclSection: string); 76 | procedure Add(const s: string); 77 | procedure Add(const Fmt: string; Args : Array of const); 78 | procedure AddLn(const s: string);overload; 79 | procedure AddLn(const Fmt: string; Args : Array of const);overload; 80 | procedure AddLn;overload; 81 | procedure AddProcArgs(aList: TfpList); virtual; 82 | public 83 | constructor Create(AStream: TStream); virtual; 84 | destructor Destroy; override; 85 | procedure AddForwardClasses(aSection: TPasSection); virtual; 86 | procedure WriteEnumType(AType: TPasEnumType); virtual; 87 | procedure WriteElement(AElement: TPasElement);virtual; 88 | procedure WriteType(AType: TPasType; Full : Boolean = True);virtual; 89 | procedure WriteProgram(aModule : TPasProgram); virtual; 90 | Procedure WriteLibrary(aModule : TPasLibrary); virtual; 91 | Procedure WriteUnit(aModule : TPasModule); virtual; 92 | procedure WriteModule(AModule: TPasModule); virtual; 93 | procedure WriteSection(ASection: TPasSection); virtual; 94 | procedure WriteUsesList(ASection: TPasSection); virtual; 95 | procedure WriteClass(AClass: TPasClassType); virtual; 96 | procedure WriteConst(AConst: TPasConst); virtual; 97 | procedure WriteVariable(AVar: TPasVariable); virtual; 98 | procedure WriteArgument(aArg: TPasArgument); virtual; 99 | procedure WriteDummyExternalFunctions(aSection: TPasSection); virtual; 100 | procedure WriteOverloadedProc(aProc : TPasOverloadedProc; ForceBody: Boolean = False; NamePrefix : String = ''); virtual; 101 | Procedure WriteAliasType(AType : TPasAliasType); virtual; 102 | Procedure WriteRecordType(AType : TPasRecordType); virtual; 103 | Procedure WriteArrayType(AType : TPasArrayType); virtual; 104 | procedure WriteProcType(AProc: TPasProcedureType); virtual; 105 | procedure WriteProcDecl(AProc: TPasProcedure; ForceBody: Boolean = False; NamePrefix : String = ''); virtual; 106 | procedure WriteProcImpl(AProc: TProcedureBody; IsAsm : Boolean = false); virtual; 107 | procedure WriteProcImpl(AProc: TPasProcedureImpl); virtual; 108 | procedure WriteProperty(AProp: TPasProperty); virtual; 109 | procedure WriteImplBlock(ABlock: TPasImplBlock); virtual; 110 | procedure WriteImplElement(AElement: TPasImplElement; AAutoInsertBeginEnd: Boolean); virtual; 111 | procedure WriteImplCommand(ACommand: TPasImplCommand);virtual; 112 | procedure WriteImplCommands(ACommands: TPasImplCommands); virtual; 113 | procedure WriteImplIfElse(AIfElse: TPasImplIfElse); virtual; 114 | procedure WriteImplForLoop(AForLoop: TPasImplForLoop); virtual; 115 | procedure WriteImplWhileDo(aWhileDo : TPasImplWhileDo); virtual; 116 | procedure WriteImplRepeatUntil(aRepeatUntil : TPasImplRepeatUntil); virtual; 117 | procedure WriteImplTryFinallyExcept(aTry: TPasImplTry); virtual; 118 | Procedure WriteImplRaise(aRaise : TPasImplRaise); virtual; 119 | Procedure WriteImplAssign(aAssign : TPasImplAssign); virtual; 120 | Procedure WriteImplSimple(aSimple: TPasImplSimple); virtual; 121 | Procedure WriteImplExceptOn(aOn : TPasImplExceptOn); virtual; 122 | // 123 | procedure wrt(const s: string); deprecated ; 124 | procedure wrtln(const s: string);overload; deprecated ; 125 | procedure wrtln;overload; deprecated ; 126 | property Stream: TStream read FStream; 127 | Published 128 | Property Options : TPasWriterOptions Read FOPtions Write FOptions; 129 | Property IndentSize : Integer Read FIndentSize Write SetIndentSize; 130 | Property LineEnding : String Read FLineEnding Write FLineEnding; 131 | Property ExtraUnits : String Read FExtraUnits Write FExtraUnits; 132 | Property ForwardClasses : TStrings Read FForwardClasses Write SetForwardClasses; 133 | Property LineNumberWidth : Integer Read FLineNumberWidth Write FLineNumberWidth; 134 | end; 135 | 136 | procedure WritePasFile(AElement: TPasElement; const AFilename: string);overload; 137 | procedure WritePasFile(AElement: TPasElement; AStream: TStream);overload; 138 | 139 | implementation 140 | 141 | type 142 | PDeclSectionStackElement = ^TDeclSectionStackElement; 143 | TDeclSectionStackElement = record 144 | LastDeclSection, LastIndent: string; 145 | end; 146 | 147 | constructor TPasWriter.Create(AStream: TStream); 148 | begin 149 | FStream := AStream; 150 | IndentSize:=2; 151 | IsStartOfLine := True; 152 | DeclSectionStack := TList.Create; 153 | FForwardClasses:=TStringList.Create; 154 | FLineEnding:=sLineBreak; 155 | FLineNumberWidth:=4; 156 | end; 157 | 158 | destructor TPasWriter.Destroy; 159 | var 160 | i: Integer; 161 | El: PDeclSectionStackElement; 162 | begin 163 | for i := 0 to DeclSectionStack.Count - 1 do 164 | begin 165 | El := PDeclSectionStackElement(DeclSectionStack[i]); 166 | Dispose(El); 167 | end; 168 | DeclSectionStack.Free; 169 | FForwardClasses.Free; 170 | inherited Destroy; 171 | end; 172 | 173 | procedure TPasWriter.Add(const s: string); 174 | begin 175 | if IsStartOfLine then // We cannot check for empty, Indent may be empty 176 | begin 177 | Inc(FCurrentLineNumber); 178 | IsStartOfLine := False; 179 | end; 180 | if (FCurrentLine='') and (S<>'') and (Length(Indent)>0) then 181 | FCurrentLine:=FCurrentLine+Indent; 182 | FCurrentLine:=FCurrentLine+S; 183 | end; 184 | 185 | procedure TPasWriter.Add(const Fmt: string; Args: array of const); 186 | begin 187 | Add(Format(Fmt,Args)); 188 | end; 189 | 190 | procedure TPasWriter.AddLn(const s: string); 191 | 192 | Var 193 | L : String; 194 | 195 | begin 196 | Add(s); 197 | L:=PostProcessLine(FCurrentLine); 198 | Stream.Write(L[1],Length(L)); 199 | Stream.Write(FLineEnding[1],Length(FLineEnding)); 200 | IsStartOfLine:=True; 201 | FCurrentLine:=''; 202 | FLineElement:=Nil; 203 | end; 204 | 205 | procedure TPasWriter.AddLn(const Fmt: string; Args: array of const); 206 | begin 207 | AddLn(Format(Fmt,Args)); 208 | end; 209 | 210 | procedure TPasWriter.AddLn; 211 | begin 212 | AddLn(''); 213 | end; 214 | 215 | procedure TPasWriter.MaybeSetLineElement(AElement : TPasElement); 216 | 217 | begin 218 | If FLineElement=Nil then 219 | FLineElement:=AElement; 220 | end; 221 | 222 | procedure TPasWriter.WriteElement(AElement: TPasElement); 223 | 224 | begin 225 | MaybeSetLineElement(AElement); 226 | if AElement.InheritsFrom(TPasModule) then 227 | WriteModule(TPasModule(AElement)) 228 | else if AElement.InheritsFrom(TPasSection) then 229 | WriteSection(TPasSection(AElement)) 230 | else if AElement.ClassType.InheritsFrom(TPasProperty) then 231 | WriteProperty(TPasProperty(AElement)) 232 | else if AElement.InheritsFrom(TPasConst) then 233 | WriteConst(TPasConst(AElement)) // Must be before variable 234 | else if AElement.InheritsFrom(TPasVariable) then 235 | WriteVariable(TPasVariable(AElement)) 236 | else if AElement.InheritsFrom(TPasArgument) then 237 | WriteArgument(TPasArgument(AElement)) 238 | else if AElement.InheritsFrom(TPasType) then 239 | WriteType(TPasType(AElement)) 240 | else if AElement.InheritsFrom(TPasOverloadedProc) then 241 | WriteOverloadedProc(TPasOverloadedProc(AElement)) 242 | else if AElement.InheritsFrom(TPasProcedureImpl) then // This one must come before TProcedureBody/TPasProcedure 243 | WriteProcImpl(TPasProcedureImpl(AElement)) 244 | else if AElement.InheritsFrom(TPasProcedure) then 245 | WriteProcDecl(TPasProcedure(AElement)) 246 | else if AElement.InheritsFrom(TProcedureBody) then 247 | WriteProcImpl(TProcedureBody(AElement)) 248 | else if AElement.InheritsFrom(TPasImplCommand) or AElement.InheritsFrom(TPasImplCommands) then 249 | WriteImplElement(TPasImplElement(AElement),false) 250 | else 251 | raise EPasWriter.CreateFmt('Writing not implemented for %s nodes',[AElement.ElementTypeName]); 252 | end; 253 | 254 | procedure TPasWriter.WriteEnumType(AType: TPasEnumType); 255 | 256 | begin 257 | Add(Atype.GetDeclaration(true)); 258 | end; 259 | 260 | procedure TPasWriter.WriteType(AType: TPasType; Full : Boolean = True); 261 | 262 | begin 263 | MaybeSetLineElement(AType); 264 | if Full and (AType.Parent is TPasSection) then 265 | PrepareDeclSection('type'); 266 | if AType.ClassType = TPasUnresolvedTypeRef then 267 | Add(AType.Name) 268 | else if AType.ClassType.InheritsFrom(TPasClassType) then 269 | WriteClass(TPasClassType(AType)) 270 | else if AType.ClassType = TPasEnumType then 271 | WriteEnumType(TPasEnumType(AType)) 272 | else if AType is TPasProcedureType then 273 | WriteProcType(TPasProcedureType(AType)) 274 | else if AType is TPasArrayType then 275 | WriteArrayType(TPasArrayType(AType)) 276 | else if AType is TPasRecordType then 277 | WriteRecordType(TPasRecordType(AType)) 278 | else if AType is TPasAliasType then 279 | WriteAliasType(TPasAliasType(AType)) 280 | else if AType is TPasPointerType then 281 | Add(AType.GetDeclaration(true)) 282 | else 283 | raise EPasWriter.Create('Writing not implemented for ' + 284 | AType.ElementTypeName + ' nodes'); 285 | if Full then 286 | AddLn(';'); 287 | end; 288 | 289 | procedure TPasWriter.WriteProgram(aModule: TPasProgram); 290 | 291 | Var 292 | S : String; 293 | 294 | begin 295 | S:=''; 296 | if aModule.Name<>'' then 297 | S:=Format('program %s',[aModule.Name]); 298 | if (S<>'') then 299 | begin 300 | If AModule.InputFile<>'' then 301 | begin 302 | S:=S+'('+aModule.InputFile; 303 | if aModule.OutPutFile<>'' then 304 | S:=S+','+aModule.OutPutFile; 305 | S:=S+')'; 306 | end; 307 | AddLn(S+';'); 308 | AddLn; 309 | end; 310 | if HasOption(woNoImplementation) then 311 | begin 312 | Addln('{$HINTS OFF}'); 313 | Addln('{$WARNINGS OFF}'); 314 | Addln('{$NOTES OFF}'); 315 | end; 316 | if Assigned(aModule.ProgramSection) then 317 | WriteSection(aModule.ProgramSection); 318 | if Assigned(AModule.InitializationSection) then 319 | begin 320 | PrepareDeclSection(''); 321 | AddLn; 322 | AddLn('begin'); 323 | IncIndent; 324 | if NotOption(woNoImplementation) then 325 | WriteImplBlock(AModule.InitializationSection); 326 | DecIndent; 327 | end; 328 | Addln('end.'); 329 | end; 330 | 331 | procedure TPasWriter.WriteLibrary(aModule: TPasLibrary); 332 | Var 333 | S : String; 334 | 335 | begin 336 | S:=''; 337 | if aModule.Name<>'' then 338 | S:=Format('library %s',[aModule.Name]); 339 | if (S<>'') then 340 | begin 341 | If AModule.InputFile<>'' then 342 | begin 343 | S:=S+'('+aModule.InputFile; 344 | if aModule.OutPutFile<>'' then 345 | S:=S+','+aModule.OutPutFile; 346 | S:=S+')'; 347 | end; 348 | AddLn(S+';'); 349 | AddLn; 350 | end; 351 | if HasOption(woNoImplementation) then 352 | begin 353 | Addln('{$HINTS OFF}'); 354 | Addln('{$WARNINGS OFF}'); 355 | Addln('{$NOTES OFF}'); 356 | end; 357 | if Assigned(AModule.InitializationSection) then 358 | begin 359 | PrepareDeclSection(''); 360 | AddLn; 361 | AddLn('begin'); 362 | IncIndent; 363 | if NotOption(woNoImplementation) then 364 | WriteImplBlock(AModule.InitializationSection); 365 | DecIndent; 366 | end; 367 | Addln('end.'); 368 | end; 369 | 370 | procedure TPasWriter.WriteDummyExternalFunctions(aSection : TPasSection); 371 | 372 | Function IsExt(P : TPasProcedure; AllowConstructor : Boolean) : Boolean; 373 | 374 | begin 375 | Result:=Assigned(P.LibrarySymbolName) or Assigned(P.LibraryExpr); 376 | if (Not Result) Then 377 | Result:=(AllowConstructor and (P is TPasConstructor)); 378 | end; 379 | 380 | Procedure DoCheckElement(E : TPasElement; Force : Boolean; Prefix: String); 381 | 382 | Var 383 | P : TPasProcedure; 384 | PP : TPasOverloadedProc; 385 | I : Integer; 386 | 387 | begin 388 | if (E is TPasProcedure) then 389 | begin 390 | P:=E as TPasProcedure; 391 | if Force or IsExt(P,False) then 392 | WriteProcDecl(P,True,Prefix) 393 | end 394 | else if (E is TPasOverloadedProc) then 395 | begin 396 | PP:=(E as TPasOverloadedProc); 397 | For I:=0 to PP.Overloads.Count-1 do 398 | begin 399 | P:=TPasProcedure(PP.Overloads[I]); 400 | if Force or IsExt(P,False) then 401 | WriteProcDecl(P,True,Prefix) 402 | end 403 | end; 404 | end; 405 | 406 | Var 407 | I,J : Integer; 408 | E,M : TPasElement; 409 | C : TPasClassType; 410 | 411 | begin 412 | Addln; 413 | Addln('// Dummy implementations for externals'); 414 | Addln; 415 | For I:=0 to aSection.Declarations.Count-1 do 416 | begin 417 | E:=TPasElement(aSection.Declarations[i]); 418 | DoCheckElement(E,False,''); 419 | if (E is TPasClassType) then 420 | begin 421 | C:=E as TPasClassType; 422 | if (C.ExternalName<>'') then 423 | For J:=0 to C.Members.Count-1 do 424 | begin 425 | M:=TPasElement(C.members[J]); 426 | DoCheckElement(M,True,C.Name+'.'); 427 | end; 428 | end; 429 | end; 430 | Addln; 431 | Addln('// end of dummy implementations'); 432 | Addln; 433 | end; 434 | 435 | procedure TPasWriter.AddForwardClasses(aSection : TPasSection); 436 | 437 | Var 438 | I : Integer; 439 | CN : String; 440 | 441 | begin 442 | if Not Assigned(aSection.Classes) or (aSection.Classes.Count=0) then 443 | exit; 444 | PrepareDeclSection('type'); 445 | For I:=0 to aSection.Classes.Count-1 do 446 | begin 447 | CN:=TPasElement(aSection.Classes[i]).Name; 448 | if (FForwardClasses.Count=0) or (ForwardClasses.IndexOf(CN)<>-1) then 449 | Addln('%s = class;',[CN]); 450 | end; 451 | end; 452 | 453 | procedure TPasWriter.WriteUnit(aModule: TPasModule); 454 | 455 | begin 456 | AddLn('unit ' + AModule.Name + ';'); 457 | if Assigned(AModule.GlobalDirectivesSection) then 458 | begin 459 | AddLn; 460 | WriteImplElement(AModule.GlobalDirectivesSection,false); 461 | end; 462 | AddLn; 463 | AddLn('interface'); 464 | AddLn; 465 | WriteSection(AModule.InterfaceSection); 466 | ResetIndent; 467 | AddLn; 468 | AddLn; 469 | AddLn('implementation'); 470 | FInImplementation:=True; 471 | if HasOption(woNoImplementation) then 472 | begin 473 | Addln('{$HINTS OFF}'); 474 | Addln('{$WARNINGS OFF}'); 475 | Addln('{$NOTES OFF}'); 476 | end; 477 | if hasOption(woNoExternalFunc) then 478 | WriteDummyExternalFunctions(AModule.InterfaceSection); 479 | if Assigned(AModule.ImplementationSection) then 480 | begin 481 | AddLn; 482 | WriteSection(AModule.ImplementationSection); 483 | end; 484 | AddLn; 485 | if NotOption(woNoImplementation) then 486 | begin 487 | PrepareDeclSection(''); 488 | if Assigned(AModule.InitializationSection) then 489 | begin 490 | AddLn('initialization'); 491 | IncIndent; 492 | WriteImplBlock(AModule.InitializationSection); 493 | DecIndent; 494 | end; 495 | if Assigned(AModule.FinalizationSection) then 496 | begin 497 | AddLn('finalization'); 498 | IncIndent; 499 | WriteImplBlock(AModule.FinalizationSection); 500 | DecIndent; 501 | end; 502 | end; 503 | AddLn('end.'); 504 | end; 505 | 506 | procedure TPasWriter.WriteModule(AModule: TPasModule); 507 | 508 | begin 509 | FInImplementation:=False;; 510 | if aModule is TPasProgram then 511 | WriteProgram(TPasProgram(aModule)) 512 | else if aModule is TPasLibrary then 513 | WriteLibrary(TPasLibrary(aModule)) 514 | else 515 | WriteUnit(aModule) 516 | end; 517 | 518 | procedure TPasWriter.WriteUsesList(ASection: TPasSection); 519 | 520 | Const 521 | UnitSeps = [',',';',' ']; 522 | 523 | Var 524 | C : Integer; 525 | 526 | function AllowUnit(S : String) : Boolean; 527 | 528 | begin 529 | Result:=Not SameText(S,'System'); 530 | end; 531 | 532 | Procedure AddUnit(Const aName : String; AUnitFile : TPasExpr); 533 | begin 534 | if c > 0 then 535 | Add(', ') 536 | else 537 | Add('uses '); 538 | Add(AName); 539 | if (AUnitFile<>Nil) then 540 | Add(' in '+GetExpr(AUnitFile)); 541 | Inc(c); 542 | end; 543 | 544 | Var 545 | I : integer; 546 | u : string; 547 | 548 | begin 549 | C:=0; 550 | if ASection.UsesList.Count>0 then 551 | begin 552 | For I:=1 to WordCount(ExtraUnits,UnitSeps) do 553 | begin 554 | u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps)); 555 | if (U<>'') then 556 | AddUnit(U,Nil); 557 | end; 558 | if length(ASection.UsesClause)=ASection.UsesList.Count then 559 | begin 560 | for i := 0 to length(ASection.UsesClause)-1 do 561 | if AllowUnit(ASection.UsesClause[i].Name) then 562 | AddUnit(ASection.UsesClause[i].Name,ASection.UsesClause[i].InFilename); 563 | end 564 | else 565 | for i := 0 to ASection.UsesList.Count - 1 do 566 | if AllowUnit(TPasElement(ASection.UsesList[i]).Name) then 567 | AddUnit(TPasElement(ASection.UsesList[i]).Name,Nil); 568 | if C>0 then 569 | begin 570 | AddLn(';'); 571 | AddLn; 572 | end; 573 | end; 574 | end; 575 | 576 | procedure TPasWriter.WriteSection(ASection: TPasSection); 577 | 578 | var 579 | i: Integer; 580 | 581 | begin 582 | WriteUsesList(aSection); 583 | CurDeclSection := ''; 584 | if HasOption(woForwardClasses) then 585 | begin 586 | AddForwardClasses(ASection); 587 | AddLn; 588 | end; 589 | for i := 0 to ASection.Declarations.Count - 1 do 590 | WriteElement(TPasElement(ASection.Declarations[i])); 591 | end; 592 | 593 | procedure TPasWriter.WriteClass(AClass: TPasClassType); 594 | 595 | var 596 | i: Integer; 597 | Member, LastMember: TPasElement; 598 | InterfacesListPrefix: string; 599 | LastVisibility, CurVisibility: TPasMemberVisibility; 600 | 601 | function ForceVisibility: boolean; 602 | begin 603 | Result := (LastMember <> nil) and 604 | // variables can't be declared directly after methods nor properties 605 | // (visibility section or var keyword is required) 606 | ((Member is TPasVariable) and not (Member is TPasProperty)) and not (LastMember is TPasVariable); 607 | end; 608 | 609 | begin 610 | PrepareDeclSection('type'); 611 | Addln; 612 | MaybeSetLineElement(AClass); 613 | Add(AClass.Name + ' = '); 614 | if AClass.IsPacked then 615 | Add('packed '); // 12/04/04 - Dave - Added 616 | case AClass.ObjKind of 617 | okObject: Add('object'); 618 | okClass: Add('class'); 619 | okInterface: Add('interface'); 620 | okRecordHelper: Add('record helper'); 621 | okClassHelper: Add('class helper'); 622 | end; 623 | if AClass.IsForward then 624 | exit; 625 | if (AClass.ObjKind=okClass) and (ACLass.ExternalName<>'') and NotOption(woNoExternalClass) then 626 | Add(' external name ''%s'' ',[AClass.ExternalName]); 627 | if Assigned(AClass.AncestorType) then 628 | Add('(' + AClass.AncestorType.Name); 629 | if AClass.Interfaces.Count > 0 then 630 | begin 631 | if Assigned(AClass.AncestorType) then 632 | InterfacesListPrefix:=', ' 633 | else 634 | InterfacesListPrefix:='('; 635 | Add(InterfacesListPrefix + TPasType(AClass.Interfaces[0]).Name); 636 | for i := 1 to AClass.Interfaces.Count - 1 do 637 | Add(', ' + TPasType(AClass.Interfaces[i]).Name); 638 | end; 639 | if Assigned(AClass.AncestorType) or (AClass.Interfaces.Count > 0) then 640 | AddLn(')') 641 | else 642 | AddLn; 643 | if AClass.ObjKind = okInterface then 644 | if Assigned(AClass.GUIDExpr) then 645 | AddLn('['+AClass.InterfaceGUID+']'); 646 | IncIndent; 647 | IncDeclSectionLevel; 648 | LastVisibility := visDefault; 649 | LastMember := nil; 650 | for i := 0 to AClass.Members.Count - 1 do 651 | begin 652 | Member := TPasElement(AClass.Members[i]); 653 | CurVisibility := Member.Visibility; 654 | if (CurVisibility <> LastVisibility) or ForceVisibility then 655 | begin 656 | DecIndent; 657 | case CurVisibility of 658 | visPrivate: AddLn('private'); 659 | visProtected: AddLn('protected'); 660 | visPublic: AddLn('public'); 661 | visPublished: AddLn('published'); 662 | visAutomated: AddLn('automated'); 663 | end; 664 | IncIndent; 665 | LastVisibility := CurVisibility; 666 | CurDeclSection := ''; 667 | end; 668 | WriteElement(Member); 669 | LastMember := Member; 670 | end; 671 | DecDeclSectionLevel; 672 | DecIndent; 673 | Add('end'); 674 | end; 675 | 676 | procedure TPasWriter.WriteConst(AConst: TPasConst); 677 | 678 | begin 679 | PrepareDeclSection('const'); 680 | AddLn(AConst.GetDeclaration(True)+';'); 681 | end; 682 | 683 | procedure TPasWriter.WriteVariable(AVar: TPasVariable); 684 | 685 | var 686 | LParentIsClassOrRecord: boolean; 687 | 688 | begin 689 | LParentIsClassOrRecord:= (AVar.Parent.ClassType = TPasClassType) or 690 | (AVar.Parent.ClassType = TPasRecordType); 691 | if not LParentIsClassOrRecord then 692 | PrepareDeclSection('var') 693 | // handle variables in classes/records 694 | else if vmClass in AVar.VarModifiers then 695 | PrepareDeclSectionInStruct('class var') 696 | else if CurDeclSection<>'' then 697 | PrepareDeclSectionInStruct('var'); 698 | Add(AVar.Name + ': '); 699 | if Not Assigned(AVar.VarType) then 700 | Raise EWriteError.CreateFmt('No type for variable %s',[AVar.Name]); 701 | WriteType(AVar.VarType,False); 702 | if (AVar.AbsoluteLocation<>'') then 703 | Add(' absolute %s',[AVar.AbsoluteLocation]) 704 | else if (aVar.LibraryName<>Nil) or Assigned (aVar.ExportName) then 705 | begin 706 | if LParentIsClassOrRecord then 707 | begin 708 | if NotOption(woNoExternalClass) then 709 | Add('; external name ''%s''',[aVar.ExportName.GetDeclaration(true)]); 710 | end 711 | else if NotOption(woNoExternalVar) then 712 | begin 713 | Add('; external '); 714 | if (AVar.LibraryName<>Nil) then 715 | Add('%s ',[AVar.LibraryName.GetDeclaration(true)]); 716 | Add('name %s',[aVar.ExportName.GetDeclaration(true)]); 717 | end; 718 | end; 719 | if Not LParentIsClassOrRecord then 720 | if Assigned(aVar.Expr) then 721 | Add(' = '+aVar.Expr.GetDeclaration(true)); 722 | AddLn(';'); 723 | end; 724 | 725 | procedure TPasWriter.WriteArgument(aArg: TPasArgument); 726 | 727 | begin 728 | if (aArg.Access<>argDefault) then 729 | Add(AccessNames[aArg.Access]+' '); 730 | Add(aArg.Name+' : '); 731 | WriteType(aArg.ArgType,False); 732 | end; 733 | 734 | procedure TPasWriter.WriteOverloadedProc(aProc: TPasOverloadedProc; ForceBody: Boolean = False; NamePrefix : String = ''); 735 | 736 | Var 737 | I : integer; 738 | 739 | begin 740 | For I:=0 to aProc.Overloads.Count-1 do 741 | begin 742 | if HasOption(woForceOverload) then 743 | TPasProcedure(aProc.Overloads[i]).AddModifier(pmOverload); 744 | WriteProcDecl(TPasElement(aProc.Overloads[i]) as TPasProcedure,ForceBody,NamePrefix); 745 | end; 746 | end; 747 | 748 | procedure TPasWriter.WriteAliasType(AType: TPasAliasType); 749 | 750 | begin 751 | If AType.Parent is TPasSection then 752 | Add(AType.GetDeclaration(true)) 753 | else 754 | Add(AType.Name) 755 | end; 756 | 757 | procedure TPasWriter.WriteRecordType(AType: TPasRecordType); 758 | 759 | Var 760 | S : TStrings; 761 | I : Integer; 762 | 763 | begin 764 | S:=TStringList.Create; 765 | try 766 | S.Text:=AType.GetDeclaration(true); 767 | For I:=0 to S.Count-2 do 768 | AddLn(S[i]); 769 | Add(S[S.Count-1]); 770 | finally 771 | S.Free; 772 | end; 773 | end; 774 | 775 | procedure TPasWriter.WriteArrayType(AType: TPasArrayType); 776 | 777 | begin 778 | Add(AType.GetDeclaration(true)); 779 | end; 780 | 781 | procedure TPasWriter.WriteProcType(AProc: TPasProcedureType); 782 | 783 | begin 784 | Add(TPasProcedureType(AProc).GetDeclaration(true)); 785 | if TPasProcedureType(AProc).CallingConvention<>ccDefault then 786 | Add('; '+cCallingConventions[TPasProcedureType(AProc).CallingConvention]); 787 | end; 788 | 789 | procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = False; NamePrefix : String = ''); 790 | 791 | Var 792 | AddExternal : boolean; 793 | IsImpl : Boolean; 794 | 795 | begin 796 | IsImpl:=AProc.Parent is TPasSection; 797 | if IsImpl then 798 | PrepareDeclSection(''); 799 | if Not IsImpl then 800 | IsImpl:=FInImplementation; 801 | Add(AProc.TypeName + ' ' + NamePrefix+AProc.Name); 802 | if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then 803 | AddProcArgs(AProc.ProcType.Args) ; 804 | if Assigned(AProc.ProcType) and 805 | (AProc.ProcType.ClassType = TPasFunctionType) then 806 | begin 807 | Add(': '); 808 | WriteType(TPasFunctionType(AProc.ProcType).ResultEl.ResultType,False); 809 | end; 810 | Add(';'); 811 | if not IsImpl then 812 | begin 813 | if AProc.IsVirtual then 814 | Add(' virtual;'); 815 | if AProc.IsDynamic then 816 | Add(' dynamic;'); 817 | if AProc.IsAbstract then 818 | Add(' abstract;'); 819 | if AProc.IsOverride then 820 | Add(' override;'); 821 | if AProc.IsReintroduced then 822 | Add(' reintroduce;'); 823 | if AProc.IsStatic then 824 | Add(' static;'); 825 | end; 826 | if pmAssembler in AProc.Modifiers then 827 | Add(' assembler;'); 828 | if AProc.IsOverload then 829 | Add(' overload;'); 830 | if AProc.CallingConvention<>ccDefault then 831 | Add(' '+cCallingConventions[AProc.CallingConvention]+';'); 832 | If Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName) then 833 | begin 834 | if AProc.Parent is TPasClassType then 835 | AddExternal:=NotOption(woNoExternalClass) 836 | else 837 | AddExternal:=NotOption(woNoExternalFunc); 838 | if AddExternal then 839 | begin 840 | add('external'); 841 | if Assigned(AProc.LibraryExpr) then 842 | Add(' '+GetExpr(AProc.LibraryExpr)); 843 | if Assigned(AProc.LibrarySymbolName) then 844 | Add(' name '+GetExpr(AProc.LibrarySymbolName)); 845 | Add(';'); 846 | end; 847 | end; 848 | AddLn; 849 | 850 | if Assigned(AProc.Body) then 851 | WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers) 852 | else if ForceBody then 853 | begin 854 | Addln(''); 855 | Addln('begin'); 856 | AddLn('end;'); 857 | Addln(''); 858 | end; 859 | 860 | end; 861 | 862 | 863 | procedure TPasWriter.AddProcArgs(aList : TfpList); 864 | 865 | Var 866 | I : Integer; 867 | A : TPasArgument; 868 | 869 | begin 870 | Add('('); 871 | If Assigned(aList) then 872 | for i := 0 to Alist.Count - 1 do 873 | begin 874 | A:= TPasArgument(AList[i]); 875 | if i > 0 then 876 | Add('; '); 877 | Add(AccessNames[A.Access]+A.Name); 878 | if Assigned(A.ArgType) then 879 | begin 880 | Add(': '); 881 | WriteType(A.ArgType,False); 882 | end; 883 | if A.Value <> '' then 884 | Add(' = ' + A.Value); 885 | end; 886 | Add(')'); 887 | end; 888 | 889 | // For backwards compatibility 890 | 891 | procedure TPasWriter.WriteProcImpl(AProc: TPasProcedureImpl); 892 | 893 | var 894 | i: Integer; 895 | E,PE :TPasElement; 896 | 897 | begin 898 | PrepareDeclSection(''); 899 | if AProc.IsClassMethod then 900 | Add('class '); 901 | Add(AProc.TypeName + ' '); 902 | if AProc.Parent.ClassType = TPasClassType then 903 | Add(AProc.Parent.Name + '.'); 904 | Add(AProc.Name); 905 | if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then 906 | AddProcArgs(AProc.ProcType.Args); 907 | if Assigned(AProc.ProcType) and 908 | (AProc.ProcType.ClassType = TPasFunctionType) then 909 | begin 910 | Add(': '); 911 | WriteType(TPasFunctionType(AProc.ProcType).ResultEl.ResultType,False); 912 | end; 913 | AddLn(';'); 914 | IncDeclSectionLevel; 915 | for i := 0 to AProc.Locals.Count - 1 do 916 | begin 917 | E:=TPasElement(AProc.Locals[i]); 918 | if E.InheritsFrom(TPasProcedureImpl) then 919 | begin 920 | IncIndent; 921 | if (i = 0) or not PE.InheritsFrom(TPasProcedureImpl) then 922 | Addln; 923 | end; 924 | WriteElement(E); 925 | if E.InheritsFrom(TPasProcedureImpl) then 926 | DecIndent; 927 | PE:=E; 928 | end; 929 | DecDeclSectionLevel; 930 | AddLn('begin'); 931 | IncIndent; 932 | if Assigned(AProc.Body) then 933 | WriteImplBlock(AProc.Body); 934 | DecIndent; 935 | AddLn('end;'); 936 | AddLn; 937 | end; 938 | 939 | procedure TPasWriter.WriteProcImpl(AProc: TProcedureBody; IsAsm : Boolean = false); 940 | 941 | var 942 | i: Integer; 943 | El,PEl : TPasElement; 944 | begin 945 | PrepareDeclSection(''); 946 | If NotOption(woNoImplementation) then 947 | begin 948 | IncDeclSectionLevel; 949 | PEl:=Nil; 950 | for i := 0 to aProc.Declarations.Count - 1 do 951 | begin 952 | El:=TPasElement(aProc.Declarations[i]); 953 | if El.InheritsFrom(TPasProcedureImpl) then 954 | begin 955 | IncIndent; 956 | if (PEL=Nil) or not PEL.InheritsFrom(TPasProcedureImpl) then 957 | AddLn; 958 | end; 959 | WriteElement(El); 960 | if El.InheritsFrom(TPasProcedureImpl) then 961 | DecIndent; 962 | Pel:=El; 963 | end; 964 | DecDeclSectionLevel; 965 | end; 966 | if IsAsm then 967 | AddLn('asm') 968 | else 969 | AddLn('begin'); 970 | If NotOption(woNoImplementation) then 971 | begin 972 | IncIndent; 973 | if Assigned(AProc.Body) then 974 | WriteImplBlock(AProc.Body); 975 | DecIndent; 976 | end; 977 | AddLn('end;'); 978 | AddLn; 979 | end; 980 | 981 | procedure TPasWriter.WriteProperty(AProp: TPasProperty); 982 | var 983 | i: Integer; 984 | begin 985 | if AProp.IsClass then 986 | Add('class '); 987 | Add('property ' + AProp.Name); 988 | if AProp.Args.Count > 0 then 989 | begin 990 | Add('['); 991 | for i := 0 to AProp.Args.Count - 1 do 992 | begin 993 | if I>0 then Add(','); 994 | WriteArgument(TPasArgument(AProp.Args[i])); 995 | end; 996 | // !!!: Create WriteArgument method and call it here 997 | Add(']'); 998 | end; 999 | if Assigned(AProp.VarType) then 1000 | begin 1001 | Add(': '); 1002 | WriteType(AProp.VarType,False); 1003 | end; 1004 | if AProp.IndexValue <> '' then 1005 | Add(' index ' + AProp.IndexValue); 1006 | if AProp.ReadAccessorName <> '' then 1007 | Add(' read ' + AProp.ReadAccessorName); 1008 | if AProp.WriteAccessorName <> '' then 1009 | Add(' write ' + AProp.WriteAccessorName); 1010 | if AProp.StoredAccessorName <> '' then 1011 | Add(' stored ' + AProp.StoredAccessorName); 1012 | if AProp.DefaultValue <> '' then 1013 | Add(' default ' + AProp.DefaultValue); 1014 | if AProp.IsNodefault then 1015 | Add(' nodefault'); 1016 | if AProp.IsDefault then 1017 | Add('; default'); 1018 | AddLn(';'); 1019 | end; 1020 | 1021 | procedure TPasWriter.WriteImplBlock(ABlock: TPasImplBlock); 1022 | var 1023 | i: Integer; 1024 | begin 1025 | for i := 0 to ABlock.Elements.Count - 1 do 1026 | begin 1027 | WriteImplElement(TPasImplElement(ABlock.Elements[i]), False); 1028 | if (TPasImplElement(ABlock.Elements[i]).ClassType = TPasImplCommand) then 1029 | begin 1030 | if TPasImplCommand(ABlock.Elements[i]).SemicolonAtEOL then 1031 | AddLn(';') 1032 | else 1033 | AddLn; 1034 | end; 1035 | end; 1036 | end; 1037 | 1038 | procedure TPasWriter.WriteImplElement(AElement: TPasImplElement; AAutoInsertBeginEnd: Boolean); 1039 | 1040 | begin 1041 | if AElement.ClassType = TPasImplCommand then 1042 | WriteImplCommand(TPasImplCommand(AElement)) 1043 | else 1044 | if AElement.ClassType = TPasImplCommands then 1045 | begin 1046 | if AAutoInsertBeginEnd then 1047 | begin 1048 | DecIndent; 1049 | AddLn('begin'); 1050 | IncIndent; 1051 | end; 1052 | WriteImplCommands(TPasImplCommands(AElement)); 1053 | if AAutoInsertBeginEnd then 1054 | begin 1055 | DecIndent; 1056 | AddLn('end;'); 1057 | IncIndent; 1058 | end; 1059 | end 1060 | else if (AElement.ClassType = TPasImplBlock) or (AElement.ClassType = TPasImplBeginBlock) then 1061 | begin 1062 | if AAutoInsertBeginEnd or (AElement.ClassType = TPasImplBeginBlock) then 1063 | begin 1064 | DecIndent; 1065 | AddLn('begin'); 1066 | IncIndent; 1067 | end; 1068 | WriteImplBlock(TPasImplBlock(AElement)); 1069 | if AAutoInsertBeginEnd or (AElement.ClassType = TPasImplBeginBlock) then 1070 | begin 1071 | DecIndent; 1072 | AddLn('end;'); 1073 | IncIndent; 1074 | end; 1075 | end 1076 | else if AElement.ClassType = TPasImplIfElse then 1077 | WriteImplIfElse(TPasImplIfElse(AElement)) 1078 | else if AElement.ClassType = TPasImplForLoop then 1079 | WriteImplForLoop(TPasImplForLoop(AElement)) 1080 | else if AElement.InheritsFrom(TPasImplWhileDo) then 1081 | WriteImplWhileDo(TPasImplWhileDo(AElement)) 1082 | else if AElement.InheritsFrom(TPasImplRepeatUntil) then 1083 | WriteImplRepeatUntil(TPasImplRepeatUntil(AElement)) 1084 | else if AElement.InheritsFrom(TPasImplTry) then 1085 | WriteImplTryFinallyExcept(TPasImplTry(aElement)) 1086 | else if AElement.InheritsFrom(TPasImplRaise) then 1087 | WriteImplRaise(TPasImplRaise(aElement)) 1088 | else if AElement.InheritsFrom(TPasImplAssign) then 1089 | WriteImplAssign(TPasImplAssign(aElement)) 1090 | else if AElement.InheritsFrom(TPasImplSimple) then 1091 | WriteImplSimple(TPasImplSimple(aElement)) 1092 | else if AElement.InheritsFrom(TPasImplExceptOn) then 1093 | WriteImplExceptOn(TPasImplExceptOn(aElement)) 1094 | else 1095 | raise EPasWriter.CreateFmt('Writing not yet implemented for %s implementation elements',[AElement.ClassName]); 1096 | end; 1097 | 1098 | procedure TPasWriter.WriteImplCommand(ACommand: TPasImplCommand); 1099 | begin 1100 | Add(ACommand.Command); 1101 | end; 1102 | 1103 | procedure TPasWriter.WriteImplCommands(ACommands: TPasImplCommands); 1104 | var 1105 | i: Integer; 1106 | s: string; 1107 | begin 1108 | for i := 0 to ACommands.Commands.Count - 1 do 1109 | begin 1110 | s := ACommands.Commands[i]; 1111 | if Length(s) > 0 then 1112 | if (Length(s) >= 2) and (s[1] = '/') and (s[2] = '/') then 1113 | AddLn(s) 1114 | else 1115 | if ACommands.SemicolonAtEOL then 1116 | AddLn(s + ';') 1117 | else 1118 | AddLn(s); 1119 | end; 1120 | end; 1121 | 1122 | procedure TPasWriter.WriteImplIfElse(AIfElse: TPasImplIfElse); 1123 | begin 1124 | Add('if ' + AIfElse.Condition + ' then'); 1125 | if Assigned(AIfElse.IfBranch) then 1126 | begin 1127 | AddLn; 1128 | if (AIfElse.IfBranch.ClassType = TPasImplCommands) or 1129 | (AIfElse.IfBranch.ClassType = TPasImplBlock) then 1130 | AddLn('begin'); 1131 | IncIndent; 1132 | WriteImplElement(AIfElse.IfBranch, False); 1133 | DecIndent; 1134 | if (AIfElse.IfBranch.ClassType = TPasImplCommands) or 1135 | (AIfElse.IfBranch.ClassType = TPasImplBlock) then 1136 | if Assigned(AIfElse.ElseBranch) then 1137 | Add('end ') 1138 | else 1139 | AddLn('end;') 1140 | else 1141 | if Assigned(AIfElse.ElseBranch) then 1142 | AddLn; 1143 | end else 1144 | if not Assigned(AIfElse.ElseBranch) then 1145 | AddLn(';') 1146 | else 1147 | AddLn; 1148 | 1149 | if Assigned(AIfElse.ElseBranch) then 1150 | if AIfElse.ElseBranch.ClassType = TPasImplIfElse then 1151 | begin 1152 | Add('else '); 1153 | WriteImplElement(AIfElse.ElseBranch, True); 1154 | end else 1155 | begin 1156 | AddLn('else'); 1157 | IncIndent; 1158 | WriteImplElement(AIfElse.ElseBranch, True); 1159 | if (not Assigned(AIfElse.Parent)) or 1160 | (AIfElse.Parent.ClassType <> TPasImplIfElse) or 1161 | (TPasImplIfElse(AIfElse.Parent).IfBranch <> AIfElse) then 1162 | AddLn(';'); 1163 | DecIndent; 1164 | end; 1165 | end; 1166 | 1167 | 1168 | procedure TPasWriter.WriteImplRepeatUntil(aRepeatUntil: TPasImplRepeatUntil); 1169 | 1170 | begin 1171 | Addln('repeat'); 1172 | with aRepeatUntil do 1173 | begin 1174 | IncIndent; 1175 | WriteImplBlock(aRepeatUntil); 1176 | DecIndent; 1177 | AddLn('until %s;',[GetExpr(ConditionExpr)]); 1178 | end; 1179 | end; 1180 | 1181 | procedure TPasWriter.WriteImplTryFinallyExcept(aTry: TPasImplTry); 1182 | begin 1183 | Addln('try'); 1184 | with aTry do 1185 | begin 1186 | IncIndent; 1187 | WriteImplBlock(aTry); 1188 | DecIndent; 1189 | if aTry.FinallyExcept is TPasImplTryFinally then 1190 | AddLn('finally') 1191 | else 1192 | AddLn('except'); 1193 | IncIndent; 1194 | WriteImplBlock(aTry.FinallyExcept); 1195 | DecIndent; 1196 | if Assigned(aTry.ElseBranch) then 1197 | begin 1198 | AddLn('else'); 1199 | IncIndent; 1200 | WriteImplBlock(aTry.ElseBranch); 1201 | DecIndent; 1202 | end; 1203 | end; 1204 | AddLn('end;') 1205 | end; 1206 | 1207 | procedure TPasWriter.WriteImplRaise(aRaise: TPasImplRaise); 1208 | begin 1209 | Add('raise %s',[GetExpr(aRaise.ExceptObject)]); 1210 | if aRaise.ExceptAddr<>Nil then 1211 | Add(' at %s',[GetExpr(aRaise.ExceptAddr)]); 1212 | Addln(';'); 1213 | end; 1214 | 1215 | procedure TPasWriter.WriteImplAssign(aAssign: TPasImplAssign); 1216 | 1217 | begin 1218 | AddLn('%s %s %s;',[GetExpr(aAssign.left),AssignKindNames[aAssign.Kind],GetExpr(aAssign.right)]); 1219 | end; 1220 | 1221 | procedure TPasWriter.WriteImplSimple(aSimple: TPasImplSimple); 1222 | begin 1223 | Addln('%s;',[GetExpr(aSimple.expr)]); 1224 | end; 1225 | 1226 | procedure TPasWriter.WriteImplExceptOn(aOn: TPasImplExceptOn); 1227 | begin 1228 | Addln('On %s : %s do',[aOn.VarEl.Name,aOn.TypeEl.Name]); 1229 | if Assigned(aOn.Body) then 1230 | WriteImplElement(aOn.Body,True); 1231 | end; 1232 | 1233 | procedure TPasWriter.wrt(const s: string); 1234 | begin 1235 | Add(s); 1236 | end; 1237 | 1238 | procedure TPasWriter.wrtln(const s: string); 1239 | begin 1240 | AddLn(s); 1241 | end; 1242 | 1243 | procedure TPasWriter.wrtln; 1244 | begin 1245 | Addln; 1246 | end; 1247 | 1248 | function TPasWriter.GetExpr(E : TPasExpr) : String; 1249 | 1250 | begin 1251 | Result:=E.GetDeclaration(True); 1252 | end; 1253 | 1254 | procedure TPasWriter.WriteImplForLoop(AForLoop: TPasImplForLoop); 1255 | 1256 | Const 1257 | ToNames : Array[Boolean] of string = ('to','downto'); 1258 | 1259 | begin 1260 | With aForLoop do 1261 | begin 1262 | If LoopType=ltIn then 1263 | AddLn('for %s in %s do',[GetExpr(VariableName),GetExpr(StartExpr)]) 1264 | else 1265 | AddLn('for %s:=%s %s %s do',[GetExpr(VariableName),GetExpr(StartExpr), 1266 | ToNames[Down],GetExpr(EndExpr)]); 1267 | IncIndent; 1268 | WriteImplElement(Body, True); 1269 | DecIndent; 1270 | if (Body is TPasImplBlock) and 1271 | (Body is TPasImplCommands) then 1272 | AddLn(';'); 1273 | end; 1274 | end; 1275 | 1276 | 1277 | procedure TPasWriter.WriteImplWhileDo(aWhileDo: TPasImplWhileDo); 1278 | 1279 | begin 1280 | With aWhileDo do 1281 | begin 1282 | AddLn('While %s do',[GetExpr(ConditionExpr)]); 1283 | IncIndent; 1284 | WriteImplElement(Body, True); 1285 | DecIndent; 1286 | if (Body.InheritsFrom(TPasImplBlock)) and 1287 | (Body.InheritsFrom(TPasImplCommands)) then 1288 | AddLn(';'); 1289 | end; 1290 | end; 1291 | 1292 | procedure TPasWriter.IncIndent; 1293 | begin 1294 | Indent := Indent + FIndentStep; 1295 | end; 1296 | 1297 | procedure TPasWriter.DecIndent; 1298 | begin 1299 | if (Length(Indent)<FIndentSize) then 1300 | raise EPasWriter.Create('Internal indent error'); 1301 | SetLength(Indent, Length(Indent) - FIndentSize); 1302 | end; 1303 | 1304 | procedure TPasWriter.IncDeclSectionLevel; 1305 | var 1306 | El: PDeclSectionStackElement; 1307 | begin 1308 | New(El); 1309 | DeclSectionStack.Add(El); 1310 | El^.LastDeclSection := CurDeclSection; 1311 | El^.LastIndent := Indent; 1312 | CurDeclSection := ''; 1313 | end; 1314 | 1315 | procedure TPasWriter.DecDeclSectionLevel; 1316 | var 1317 | El: PDeclSectionStackElement; 1318 | begin 1319 | if DeclSectionStack.Count=0 then 1320 | raise EPasWriter.Create('Internal section indent error'); 1321 | El := PDeclSectionStackElement(DeclSectionStack[DeclSectionStack.Count - 1]); 1322 | DeclSectionStack.Delete(DeclSectionStack.Count - 1); 1323 | CurDeclSection := El^.LastDeclSection; 1324 | Indent := El^.LastIndent; 1325 | Dispose(El); 1326 | end; 1327 | 1328 | procedure TPasWriter.PrepareDeclSection(const ADeclSection: string); 1329 | begin 1330 | if Not SameText(ADeclSection,CurDeclSection) then 1331 | begin 1332 | if CurDeclsection <> '' then 1333 | begin 1334 | DecIndent; 1335 | end; 1336 | if ADeclSection <> '' then 1337 | begin 1338 | AddLn(ADeclSection); 1339 | IncIndent; 1340 | end; 1341 | CurDeclSection := ADeclSection; 1342 | end; 1343 | end; 1344 | 1345 | procedure TPasWriter.PrepareDeclSectionInStruct(const ADeclSection: string); 1346 | 1347 | begin 1348 | if Not SameText(ADeclSection,CurDeclSection) then 1349 | begin 1350 | if ADeclSection <> '' then 1351 | begin 1352 | DecIndent; 1353 | AddLn(ADeclSection); 1354 | IncIndent; 1355 | end; 1356 | CurDeclSection := ADeclSection; 1357 | end; 1358 | end; 1359 | 1360 | procedure TPasWriter.SetForwardClasses(AValue: TStrings); 1361 | begin 1362 | if FForwardClasses=AValue then Exit; 1363 | FForwardClasses.Assign(AValue); 1364 | end; 1365 | 1366 | procedure TPasWriter.SetIndentSize(AValue: Integer); 1367 | begin 1368 | if AValue=FIndentSize then exit; 1369 | if AValue<0 then 1370 | AValue:=0; 1371 | FIndentSize:=AValue; 1372 | FIndentStep:=StringOfChar(' ',aValue); 1373 | end; 1374 | 1375 | function TPasWriter.HasOption(aOption: TPasWriterOption): Boolean; 1376 | begin 1377 | Result:=(aOption in FOptions) 1378 | end; 1379 | 1380 | function TPasWriter.NotOption(aOption: TPasWriterOption): Boolean; 1381 | begin 1382 | Result:=Not (aOption in FOptions) 1383 | end; 1384 | 1385 | function TPasWriter.PostProcessLine(S: String): String; 1386 | begin 1387 | Result:=S; 1388 | if HasOption(woAddLineNumber) or HasOption(woAddSourceLineNumber) then 1389 | Result:=GetLineNumberComment+Result; 1390 | end; 1391 | 1392 | function TPasWriter.GetLineNumberComment: String; 1393 | 1394 | Var 1395 | Ln,OL : string; 1396 | 1397 | begin 1398 | OL:=''; 1399 | LN:=''; 1400 | if Hasoption(woAddSourceLineNumber) then 1401 | if Assigned(FLineElement) then 1402 | OL:=Format('%.*d',[LineNumberWidth,FLineElement.SourceLinenumber]) 1403 | else 1404 | ol:=StringOfChar(' ',LineNumberWidth); 1405 | if HasOption(woAddLineNumber) then 1406 | begin 1407 | LN:=Format('%.*d',[LineNumberWidth,FCurrentLineNumber]); 1408 | if OL<>'' then 1409 | OL:=' '+OL 1410 | end; 1411 | Result:='{ '+LN+OL+' }'; 1412 | end; 1413 | 1414 | procedure TPasWriter.ResetIndent; 1415 | 1416 | Var 1417 | I : integer; 1418 | E : PDeclSectionStackElement; 1419 | 1420 | begin 1421 | CurDeclSection:=''; 1422 | Indent:=''; 1423 | For I:=DeclSectionStack.Count-1 downto 0 do 1424 | begin 1425 | E:=PDeclSectionStackElement(DeclSectionStack[i]); 1426 | Dispose(E); 1427 | end; 1428 | DeclSectionStack.Clear; 1429 | end; 1430 | 1431 | procedure WritePasFile(AElement: TPasElement; const AFilename: string); 1432 | var 1433 | Stream: TFileStream; 1434 | begin 1435 | Stream := TFileStream.Create(AFilename, fmCreate); 1436 | try 1437 | WritePasFile(AElement, Stream); 1438 | finally 1439 | Stream.Free; 1440 | end; 1441 | end; 1442 | 1443 | procedure WritePasFile(AElement: TPasElement; AStream: TStream); 1444 | var 1445 | Writer: TPasWriter; 1446 | begin 1447 | Writer := TPasWriter.Create(AStream); 1448 | try 1449 | Writer.WriteElement(AElement); 1450 | finally 1451 | Writer.Free; 1452 | end; 1453 | end; 1454 | 1455 | end. 1456 | --------------------------------------------------------------------------------