├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── bootstrap_js.pl ├── demo.pl ├── demo2.pl ├── fli.js ├── foreign.js ├── gc.js ├── js_preprocess.pl ├── opcodes.pl ├── read.js ├── record.js ├── standalone.js ├── stream.js ├── test.css ├── test.html ├── test.js ├── testing.pl ├── tests.pl ├── wam.js ├── wam_bootstrap.pl └── wam_compiler.pl /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *-pp.js 3 | bootstrap.js -------------------------------------------------------------------------------- /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 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 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 | {project} Copyright (C) {year} {fullname} 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 | 676 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | JSC=/System/Library/Frameworks/JavaScriptCore.framework/Versions/A/Resources/jsc 2 | DEBUG=false 3 | SWIPL=/opt/swipl-7.1.32/bin/swipl 4 | 5 | 6 | all: bootstrap.js wam-pp.js 7 | clean: 8 | rm -f wam-pp.js bootstrap.js 9 | 10 | bootstrap.js: wam_compiler.pl testing.pl wam_bootstrap.pl bootstrap_js.pl demo.pl tests.pl 11 | $(SWIPL) -q -f wam_compiler.pl -g "build_saved_state(['wam_compiler.pl', 'bootstrap_js.pl', 'demo.pl'], foo), halt" 12 | 13 | wam-pp.js: foreign.js wam.js read.js record.js fli.js stream.js gc.js 14 | $(SWIPL) -q -f js_preprocess.pl -g "preprocess(['foreign.js', 'wam.js', 'read.js', 'record.js', 'fli.js', 'stream.js', 'gc.js'], 'wam-pp.js', [debug=$(DEBUG)]), halt" 15 | 16 | test: wam-pp.js bootstrap.js standalone.js wam_compiler.pl tests.pl 17 | $(SWIPL) -q -f wam_compiler.pl -g "bootstrap('tests.pl', run_unit_tests), halt" 18 | $(JSC) wam-pp.js bootstrap.js standalone.js -e "unit_tests($(DEBUG))" 19 | 20 | demo: wam-pp.js bootstrap.js standalone.js 21 | $(JSC) wam-pp.js bootstrap.js standalone.js -e "demo($(DEBUG))" 22 | 23 | gc: wam-pp.js bootstrap.js standalone.js 24 | $(JSC) wam-pp.js bootstrap.js standalone.js -e "gc_test($(DEBUG))" 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # proscript 2 | A Javascript implementation of Prolog 3 | 4 | This is currently just a dump of what I was last doing since I got permission from the other copyright owners to publish it 5 | It needs a lot of tidying and organisation! 6 | 7 | ## Organisation 8 | ### The WAM implementation 9 | This is implemented primarily in wam.js. Extra stuff is also present in: 10 | * fli.js: SWI-Prolog-like foreign langauge interface. Allows escaping to Javascript from Prolog, so you can call low(er) level functions. Huge chunks of this (like PL_cut_query!) are not implemented 11 | * foreign.js: This implements a lot of core WAM building blocks directly in javascript. For example, you will find implemntations for univ, writeln and halt here. 12 | * gc.js: Implements a garbage collector 13 | * read.js: Handles input and output of terms, including parsing Prolog terms 14 | * record.js: Handles dynamic adjustment of the state: assert and friends 15 | * stream.js: Handles reading and writing to streams, and all the ISO predicates (the ones implemented anyway) like get_char/2 and put_code/2. 16 | 17 | ### Bits you must implement, and the stubs provided 18 | * standalone.js: Contains implementations of stdout and flush_stdout/1. You can either include this (in which case you will get output printed to a variable called stdout_buffer), or implement them yourself to do something /with/ the stuff written to stdout. 19 | 20 | You might think that was all you needed, but then you need some code to run on your WAM, which is where the compiler comes in! 21 | 22 | ### The compiler 23 | The compiler is itself written in Prolog. We must go deeper. 24 | 25 | * wam_compiler.pl: The guts of the compiler. Exports build_saved_state/2 and bootstrap/2, both actually located in wam_boostrap.pl 26 | * wam_boostrap.pl: This is the part of the compiler only executed in the bootstrapping process to generate the boostrapped compiler. 27 | * bootstrap_js.pl: This is the part of the compiler compiled by the bootstrapping compiler to generate the saved state for the actual compiled system 28 | * testing.pl: Contains implementations of debugging predicates used for debugging the compiler 29 | 30 | Compiling the compiler produces: 31 | * bootstrap.js (the saved state) 32 | * wam-pp.js (the executable runtime) 33 | 34 | You must include both of these if you want a working system. See test.html for an example. 35 | 36 | ### Tidying things up 37 | * js_preprocess.pl: This is a minification process that combines several files together to form wam-pp.js, which is the final system used for execution 38 | 39 | ## Trying it out 40 | test.html provides an execution environment for you to try out the final state 41 | 42 | -------------------------------------------------------------------------------- /bootstrap_js.pl: -------------------------------------------------------------------------------- 1 | assert(Term):- 2 | assertz(Term). 3 | 4 | save_clausea(Head:-Body):- 5 | functor(Head, Name, Arity), 6 | prepend_clause_to_predicate(Name/Arity, Head, Body). 7 | 8 | save_clausea(Fact):- 9 | !, 10 | functor(Fact, Name, Arity), 11 | prepend_clause_to_predicate(Name/Arity, Fact, true). 12 | 13 | call(Goal):- 14 | term_variables(Goal, Vars), 15 | % Compile this into a predicate, but do not actually declare it anywhere. 16 | % The functor is therefore irrelevant. 17 | compile_clause_2(query(Vars):-Goal), 18 | !, 19 | % Now we need to call our anonymous predicate. $jmp does the trick here 20 | '$jmp'(Vars), 21 | % But jmp must never be the last thing in a body, because foreign execute() will cause P <- CP after it succeeds 22 | % and I dont want to muck with CP inside $jmp. 23 | true. 24 | 25 | consult_atom(Atom):- 26 | % FIXME: Needs to abolish the old clauses! 27 | compile_atom(Atom). 28 | 29 | format(Format, Args):- 30 | current_output(Stream), format(Stream, Format, Args). 31 | 32 | %compile_message(X):-writeln(X). 33 | compile_message(_). 34 | 35 | ??(Goal):- 36 | setup_call_catcher_cleanup(format('CALL ~q~n', [Goal]), 37 | call(Goal), 38 | Catcher, 39 | ( Catcher == fail -> 40 | format('FAIL ~q~n', [Goal]) 41 | ; Catcher == exit -> 42 | format('EXIT ~q~n', [Goal]) 43 | ; Catcher == ! -> 44 | format('CUT ~q~n', [Goal]) 45 | ; Catcher = error(Error)-> 46 | format('ERROR ~q ~p~n', [Goal, Error]) 47 | )), 48 | ( var(Catcher)-> 49 | format('PEND ~q~n', [Goal]) 50 | ; otherwise-> 51 | true 52 | ). 53 | 54 | ?(Goal):- 55 | functor(Goal, Functor, Arity), 56 | setup_call_catcher_cleanup(format('CALL ~q~n', [Functor/Arity]), 57 | call(Goal), 58 | Catcher, 59 | ( Catcher == fail -> 60 | format('FAIL ~q~n', [Goal]) 61 | ; Catcher == exit -> 62 | format('EXIT ~q~n', [Functor/Arity]) 63 | ; Catcher == ! -> 64 | format('CUT ~q~n', [Functor/Arity]) 65 | ; Catcher = error(Error)-> 66 | format('ERROR ~q ~p~n', [Functor/Arity, Error]) 67 | )), 68 | ( var(Catcher)-> 69 | format('PEND ~q~n', [Functor/Arity]) 70 | ; otherwise-> 71 | true 72 | ). 73 | 74 | otherwise. 75 | 76 | % Exceptions are implement as per Bart Demoen's 1989 paper 77 | % http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.57.4354&rep=rep1&type=pdf 78 | /* This is now compiled directly to save on having call/1 in the code 79 | catch(Goal, Catcher, Recovery):- 80 | get_current_block(Block), 81 | catch_1(Goal, Catcher, Recovery, Block). 82 | catch_1(Goal, Catcher, Recovery, Block):- 83 | install_new_block(NewBlock), 84 | call(Goal), 85 | end_block(Block, NewBlock). 86 | catch_1(Goal, Catcher, Recovery, Block):- 87 | reset_block(Block), 88 | get_exception(Ball), 89 | catch_2(Ball, Catcher, Recovery). 90 | 91 | catch_2(Ball, Ball, Recovery):- 92 | clear_exception, 93 | !, 94 | call(Recovery). 95 | 96 | catch_2(_, _, _):- 97 | unwind_stack. 98 | */ 99 | 100 | end_block(Block, NewBlock):- 101 | clean_up_block(NewBlock), 102 | reset_block(Block). 103 | 104 | end_block(_, NewBlock):- 105 | reset_block(NewBlock), 106 | fail. 107 | 108 | 109 | % setof/3, bagof/3, findall/3 and findall/4 as implemented by Richard O'Keefe and David Warren. 110 | % http://www.j-paine.org/prolog/tools/files/setof.pl 111 | 112 | 113 | findall(Template, Generator, List) :- 114 | save_instances(-Template, Generator), 115 | list_instances([], List). 116 | 117 | findall(Template, Generator, SoFar, List) :- 118 | save_instances(-Template, Generator), 119 | list_instances(SoFar, List). 120 | 121 | set_of(Template, Filter, Set) :- 122 | bag_of(Template, Filter, Bag), 123 | sort(Bag, Set). 124 | 125 | bag_of(Template, Generator, Bag) :- 126 | free_variables(Generator, Template, [], Vars), 127 | Vars \== [], 128 | !, 129 | Key =.. [.|Vars], 130 | functor(Key, ., N), 131 | save_instances(Key-Template, Generator), 132 | list_instances(Key, N, [], OmniumGatherum), 133 | keysort(OmniumGatherum, Gamut), !, 134 | concordant_subset(Gamut, Key, Answer), 135 | Bag = Answer. 136 | bag_of(Template, Generator, Bag) :- 137 | save_instances(-Template, Generator), 138 | list_instances([], Bag), 139 | Bag \== []. 140 | 141 | save_instances(Template, Generator) :- 142 | recorda(., -, _), 143 | call(Generator), 144 | recorda(., Template, _), 145 | fail. 146 | save_instances(_, _). 147 | 148 | 149 | list_instances(SoFar, Total) :- 150 | recorded(., Term, Ref), 151 | erase(Ref), !, % must not backtrack 152 | list_instances(Term, SoFar, Total). 153 | 154 | list_instances(-, SoFar, Total) :- !, 155 | Total = SoFar. % = delayed in case Total was bound 156 | list_instances(-Template, SoFar, Total) :- 157 | list_instances([Template|SoFar], Total). 158 | 159 | list_instances(Key, NVars, OldBag, NewBag) :- 160 | recorded(., Term, Ref), 161 | erase(Ref), !, % must not backtrack! 162 | list_instances(Term, Key, NVars, OldBag, NewBag). 163 | 164 | list_instances(-, _, _, AnsBag, AnsBag) :- !. 165 | list_instances(NewKey-Term, Key, NVars, OldBag, NewBag) :- 166 | replace_key_variables(NVars, Key, NewKey), !, 167 | list_instances(Key, NVars, [NewKey-Term|OldBag], NewBag). 168 | 169 | replace_key_variables(0, _, _) :- !. 170 | replace_key_variables(N, OldKey, NewKey) :- 171 | arg(N, NewKey, Arg), 172 | nonvar(Arg), !, 173 | M is N-1, 174 | replace_key_variables(M, OldKey, NewKey). 175 | replace_key_variables(N, OldKey, NewKey) :- 176 | arg(N, OldKey, OldVar), 177 | arg(N, NewKey, OldVar), 178 | M is N-1, 179 | replace_key_variables(M, OldKey, NewKey). 180 | 181 | 182 | concordant_subset([Key-Val|Rest], Clavis, Answer) :- 183 | concordant_subset(Rest, Key, List, More), 184 | concordant_subset(More, Key, [Val|List], Clavis, Answer). 185 | 186 | concordant_subset([Key-Val|Rest], Clavis, [Val|List], More) :- 187 | Key == Clavis, 188 | !, 189 | concordant_subset(Rest, Clavis, List, More). 190 | concordant_subset(More, _, [], More). 191 | 192 | concordant_subset([], Key, Subset, Key, Subset) :- !. 193 | concordant_subset(_, Key, Subset, Key, Subset). 194 | concordant_subset(More, _, _, Clavis, Answer) :- 195 | concordant_subset(More, Clavis, Answer). 196 | 197 | 198 | % ISO predicates 199 | % 8.2 200 | % =/2 (foreign) 201 | unify_with_occurs_check(A, A):- acyclic_term(A). 202 | \=(A,B):- \+(A=B). 203 | 204 | % 8.3 (Complete) 205 | % var/1 (foreign) 206 | % atom/1 (foreign) 207 | % integer/1 (foreign) 208 | % float/1 (foreign) 209 | atomic(X):- (atom(X)-> true ; number(X)). 210 | % compound/1 (foreign) 211 | nonvar(X):- \+var(X). 212 | number(X):- (integer(X)-> true; float(X)). 213 | 214 | % 8.4 215 | % @=/2 (foreign) 220 | % @>=/2 (foreign) 221 | 222 | % 8.5 223 | % functor/3 (foreign) 224 | % arg/3 (foreign) 225 | % =../2 (foreign) 226 | % copy_term/2 (foreign) 227 | 228 | % 8.6: Arithmetic. 229 | % is/2 (foreign) 230 | 231 | % 8.7: Arithmetic comparison 232 | % =:=/2 (foreign) 233 | % =\=/2 (foreign) 234 | % (<)/2 (foreign) 235 | % (=<)/2 (foreign) 236 | % (>)/2 (foreign) 237 | % (>=)/2 (foreign) 238 | 239 | % 8.8 240 | % clause/2 (foreign) 241 | % current_predicate/1 (foreign) 242 | 243 | % 8.9 244 | asserta(Term):- compile_clause_2(Term), save_clausea(Term). 245 | assertz(Term):- compile_clause_2(Term), save_clause(Term). 246 | retract(Head:-Body):- !, retract_clause(Head, Body). 247 | retract(Fact):- !, retract_clause(Fact, true). 248 | % abolish/1 (foreign) 249 | 250 | % 8.10 251 | % findall/3 (Implemented above) 252 | setof(A,B,C):- set_of(A,B,C). 253 | bagof(A,B,C):- bag_of(A,B,C). 254 | 255 | % 8.11 streams 256 | % current_input/1 (foreign) 257 | % current_output/1 (foreign) 258 | % set_input/1 (foreign) 259 | % set_output/1 (foreign) 260 | open(Resource, Mode, Stream):- open(Resource, Mode, Stream, []). 261 | open(_,_,_,_):- throw(no_files_in_javascript). % FIXME 262 | % close/2 (foreign) 263 | close(Stream):- close(Stream, []). 264 | flush_output:- current_output(S), flush_output(S). 265 | % flush_output/1 (foreign) 266 | stream_property(Stream, Property):- var(Stream), !, current_stream(Stream), stream_property_1(Stream, Property). 267 | stream_property(Stream, Property):- stream_property_1(Stream, Property). 268 | at_end_of_stream:- current_output(S), at_end_of_stream(S). 269 | % at_end_of_stream/1 (foreign) 270 | % set_stream_position/2 (foreign) 271 | 272 | % 8.12 char IO. 273 | % get_char/2 (foreign) 274 | get_char(C):- current_input(S), get_char(S, C). 275 | % get_code/2 (foreign) 276 | get_code(C):- current_input(S), get_code(S, C). 277 | % peek_char/2 (foreign) 278 | peek_char(C):- current_input(S), peek_char(S, C). 279 | % peek_code/2 (foreign) 280 | peek_code(C):- current_input(S), peek_code(S, C). 281 | % put_char/2 (foreign) 282 | put_char(C):- current_output(S), put_char(S, C). 283 | % put_code/2 (foreign) 284 | put_code(C):- current_output(S), put_code(S, C). 285 | 286 | % 8.13 287 | % get_byte/2 (foreign) 288 | get_byte(B):- current_input(S), get_byte(S, B). 289 | % peek_byte/2 (foreign) 290 | peek_byte(B):- current_input(S), peek_byte(S, B). 291 | % put_byte/2 (foreign) 292 | put_byte(B):- current_output(S), put_byte(S, B). 293 | 294 | % 8.14 Term IO. 295 | % read_term/3 (foreign) 296 | read_term(Term, Options):- current_input(S), read_term(S, Term, Options). 297 | read(Term):-current_input(S), read(S, Term, []). 298 | read(Stream, Term):- read_term(Stream, Term, []). 299 | % write_term/3 (foreign) 300 | write_term(Term, Options):- current_output(Stream), write_term(Stream, Term, Options). 301 | write(Term):- current_output(S), write_term(S, Term, [quoted(false), ignore_ops(false), numbervars(true)]). 302 | write(Stream, Term):- write_term(Stream, Term, [quoted(false), ignore_ops(false), numbervars(true)]). 303 | writeq(Term):- current_output(Stream), write_term(Stream, Term, [quoted(true), ignore_ops(false), numbervars(true)]). 304 | writeq(Stream, Term):- write_term(Stream, Term, [quoted(true), ignore_ops(false), numbervars(true)]). 305 | write_canonical(Term):- current_output(Stream), write_term(Stream, Term, [quoted(true), ignore_ops(true), numbervars(false)]). 306 | write_canonical(Stream, Term):- write_term(Stream, Term, [quoted(true), ignore_ops(true), numbervars(false)]). 307 | % op/3 (foreign) 308 | % current_op/3 (foreign) 309 | % char_conversion/2 (foreign) 310 | % current_char_conversion/2 (foreign) 311 | 312 | % 8.15 313 | % (\+)/1 (foreign) 314 | % once/1 (foreign) 315 | % repeat/0 (foreign) 316 | 317 | % 8.16 318 | % atom_length/2 (foreign) 319 | % atom_concat/3 (foreign) 320 | % sub_atom/5 (foreign) 321 | % char_code/2 (foreign) 322 | % atom_chars/2 (foreign) 323 | % atom_codes/2 (foreign) 324 | % number_codes/2 (foreign) 325 | % number_chars/2 (foreign) 326 | 327 | % 8.17 328 | % set_prolog_flag/2 (foreign) 329 | % current_prolog_flag/2 (foreign) 330 | halt:- halt(0). 331 | % halt/1 (foreign). 332 | 333 | % Corrigendum 334 | % compare/3 (foreign) 335 | % sort/2 (above) 336 | % keysort/2 (above) 337 | % ground/1 (foreign) 338 | % call/2-8 Implemented in this file 339 | % false/0 (foreign) 340 | callable(X):- (atom(X) -> true ; compound(X)). 341 | % subsumes_term/2 (foreign) 342 | % acyclic_term/1 (foreign) 343 | % term_variables/2 (foreign) 344 | retractall(Goal):- retract(Goal), fail. 345 | retractall(_). 346 | 347 | 348 | sort([X|Xs],Ys) :- 349 | partition(Xs,X,Left,Right), 350 | sort(Left,Ls), 351 | sort(Right,Rs), 352 | append(Ls,[X|Rs],Ys). 353 | sort([],[]). 354 | 355 | keysort([Key-X|Xs],Ys) :- 356 | key_partition(Xs,Key,Left,Right), 357 | keysort(Left,Ls), 358 | keysort(Right,Rs), 359 | append(Ls,[Key-X|Rs],Ys). 360 | keysort([],[]). 361 | 362 | partition([X|Xs],Y,Ls,Rs) :- 363 | X == Y, 364 | !, 365 | partition(Xs, Y, Ls, Rs). 366 | partition([X|Xs],Y,[X|Ls],Rs) :- 367 | X @=< Y, 368 | partition(Xs,Y,Ls,Rs). 369 | 370 | partition([X|Xs],Y,Ls,[X|Rs]) :- 371 | X @> Y, 372 | partition(Xs,Y,Ls,Rs). 373 | partition([],_,[],[]). 374 | 375 | key_partition([XKey-_|Xs],YKey,Ls,Rs) :- 376 | XKey == YKey, 377 | !, 378 | key_partition(Xs,YKey,Ls,Rs). 379 | key_partition([XKey-X|Xs],YKey,[XKey-X|Ls],Rs) :- 380 | XKey @=< YKey, 381 | key_partition(Xs,YKey,Ls,Rs). 382 | key_partition([XKey-X|Xs],YKey,Ls,[XKey-X|Rs]) :- 383 | XKey @> YKey, 384 | key_partition(Xs,YKey,Ls,Rs). 385 | key_partition([],_,[],[]). 386 | 387 | 388 | append([],Ys,Ys). 389 | append([X|Xs],Ys,[X|Zs]) :- 390 | append(Xs,Ys,Zs). 391 | 392 | call(A, B):- 393 | A =.. [Functor|Args], 394 | append(Args, [B], NewArgs), 395 | AA =.. [Functor|NewArgs], 396 | call(AA). 397 | 398 | call(A, B, C):- 399 | A =.. [Functor|Args], 400 | append(Args, [B, C], NewArgs), 401 | AA =.. [Functor|NewArgs], 402 | call(AA). 403 | 404 | 405 | call(A, B, C, D):- 406 | A =.. [Functor|Args], 407 | append(Args, [B, C, D], NewArgs), 408 | AA =.. [Functor|NewArgs], 409 | call(AA). 410 | 411 | 412 | call(A, B, C, D, E):- 413 | A =.. [Functor|Args], 414 | append(Args, [B, C, D, E], NewArgs), 415 | AA =.. [Functor|NewArgs], 416 | call(AA). 417 | 418 | 419 | call(A, B, C, D, E, F):- 420 | A =.. [Functor|Args], 421 | append(Args, [B, C, D, E, F], NewArgs), 422 | AA =.. [Functor|NewArgs], 423 | call(AA). 424 | 425 | 426 | call(A, B, C, D, E, F, G):- 427 | A =.. [Functor|Args], 428 | append(Args, [B, C, D, E, F, G], NewArgs), 429 | AA =.. [Functor|NewArgs], 430 | call(AA). 431 | 432 | 433 | call(A, B, C, D, E, F, G, H):- 434 | A =.. [Functor|Args], 435 | append(Args, [B, C, D, E, F, G, H], NewArgs), 436 | AA =.. [Functor|NewArgs], 437 | call(AA). 438 | 439 | 440 | -------------------------------------------------------------------------------- /demo.pl: -------------------------------------------------------------------------------- 1 | foo:- 2 | setup_call_catcher_cleanup(true, 3 | subsumes_term(X, f(X)), 4 | _, 5 | true). 6 | 7 | /* 8 | foo:- 9 | setup_call_catcher_cleanup(true, 10 | ( setup_call_catcher_cleanup(true, 11 | repeat, 12 | Catcher, 13 | writeln(inner_cleanup(Catcher))), 14 | true, !), 15 | Port, 16 | writeln(outer_cleanup(Port))), 17 | writeln(Port). 18 | */ 19 | 20 | /* 21 | deterministic_goal. 22 | nondeterministic_goal. 23 | nondeterministic_goal. 24 | goal_that_fails:- fail. 25 | goal_raising_exception:- throw(egg). 26 | 27 | check_value(A, B):- A==B, !. 28 | check_value(A, B):- throw(mismatch(A,B)). 29 | 30 | 31 | foo:- 32 | test1, 33 | writeln(ok(1)), 34 | test2, 35 | writeln(ok(2)), 36 | test3, 37 | writeln(ok(3)), 38 | test4, 39 | writeln(ok(4)), 40 | test5, 41 | writeln(ok(5)). 42 | 43 | test1:- 44 | setup_call_catcher_cleanup(Setup=ok, 45 | deterministic_goal, 46 | Catcher, 47 | Cleanup=ok), 48 | Setup == ok, 49 | Cleanup == ok, 50 | Catcher == exit. 51 | 52 | test2:- 53 | setup_call_catcher_cleanup(Setup=ok, 54 | nondeterministic_goal, 55 | Catcher, 56 | Cleanup=ok), 57 | Setup == ok, 58 | var(Catcher), 59 | var(Cleanup), 60 | !, 61 | Cleanup == ok, 62 | Catcher == !. 63 | 64 | test3:- 65 | setup_call_catcher_cleanup(Setup=ok, 66 | goal_that_fails, 67 | Catcher, 68 | ( check_value(Setup, ok), 69 | check_value(Catcher, fail))). 70 | 71 | test3. 72 | 73 | error_setup_call_cleanup_test_1:- 74 | setup_call_catcher_cleanup(Setup=ok, 75 | goal_raising_exception, 76 | Catcher, 77 | ( check_value(Setup, ok), 78 | check_value(Catcher, exception(egg)))), 79 | throw(unexpected_success). 80 | 81 | test4:- 82 | catch(error_setup_call_cleanup_test_1, 83 | Exception, 84 | Error = Exception), 85 | check_value(Error, egg). 86 | 87 | 88 | test5:- 89 | setup_call_catcher_cleanup(true, 90 | setup_call_catcher_cleanup(true, 91 | true, 92 | C1, 93 | true), 94 | C2, 95 | true), 96 | C1 == exit, 97 | C2 == exit. 98 | */ -------------------------------------------------------------------------------- /demo2.pl: -------------------------------------------------------------------------------- 1 | foo:- 2 | bar, 3 | !, 4 | baz. 5 | 6 | foo:- 7 | writeln(second_foo). 8 | 9 | bar. 10 | baz:- fail. -------------------------------------------------------------------------------- /fli.js: -------------------------------------------------------------------------------- 1 | /* Not implemented: 2 | All the nondet foreign stuff. That is supported, but not using the SWI-Prolog interface 3 | Strings 4 | Floats 5 | Pointers 6 | PL_get_chars 7 | PL_predicate_info 8 | PL_copy_term_ref 9 | PL_reset_term_refs 10 | */ 11 | 12 | function PL_new_term_ref() 13 | { 14 | // FIXME: Should this go on the heap or the stack? 15 | return alloc_var(); 16 | } 17 | 18 | function PL_new_term_refs(n) 19 | { 20 | var first = alloc_var(); 21 | for (i = 0; i < n-1; i++) 22 | alloc_var(); 23 | 24 | } 25 | 26 | function PL_succeed() 27 | { 28 | return true; 29 | } 30 | 31 | function PL_fail() 32 | { 33 | return true; 34 | } 35 | 36 | function PL_new_atom(chars) 37 | { 38 | return lookup_atom(chars); 39 | } 40 | 41 | function PL_atom_chars(atom) 42 | { 43 | return atable[VAL(atom)]; 44 | } 45 | 46 | function PL_new_functor(name, arity) 47 | { 48 | return lookup_functor(atable[name], arity); 49 | } 50 | 51 | function PL_functor_name(ftor) 52 | { 53 | return ftable[VAL(ftor)][0]; 54 | } 55 | 56 | function PL_functor_arity(ftor) 57 | { 58 | return ftable[VAL(ftor)][1]; 59 | } 60 | 61 | function PL_term_type(term) 62 | { 63 | return TAG(term); 64 | } 65 | 66 | function PL_is_variable(term) 67 | { 68 | return TAG(term) == TAG_REF; 69 | } 70 | 71 | function PL_is_atom(term) 72 | { 73 | return TAG(term) == TAG_ATM; 74 | } 75 | 76 | function PL_is_integer(term) 77 | { 78 | return TAG(term) == TAG_INT; 79 | } 80 | 81 | function PL_is_compound(term) 82 | { 83 | return TAG(term) == TAG_STR; 84 | } 85 | 86 | function PL_is_functor(term, ftor) 87 | { 88 | return TAG(term) == TAG_STR && memory[VAL(term)] == ftor; 89 | } 90 | 91 | function PL_is_list(term) 92 | { 93 | return TAG(term) == TAG_LST; 94 | } 95 | 96 | function PL_is_atomic(term) 97 | { 98 | return TAG(term) != TAG_STR && TAG(term) != TAG_REF; 99 | } 100 | 101 | function PL_is_number(term) 102 | { 103 | return TAG(term) == TAG_INT; // At the moment 104 | } 105 | 106 | function PL_get_atom(term) 107 | { 108 | if (TAG(term) == TAG_ATM) 109 | return atom; 110 | throw("type_error: atom"); 111 | } 112 | 113 | function PL_get_atom_chars(term) 114 | { 115 | if (TAG(term) == TAG_ATOM) 116 | return atable[VAL(term)]; 117 | throw("type_error: atom"); 118 | } 119 | 120 | function PL_get_integer(term) 121 | { 122 | if (TAG(term) == TAG_INT) 123 | return VAL(term); 124 | throw("type_error: integer"); 125 | } 126 | 127 | function PL_get_functor(term) 128 | { 129 | if (TAG(term) == TAG_STR) 130 | return memory[VAL(term)]; 131 | throw("type_error: term"); 132 | } 133 | 134 | function PL_get_arg(index, term) 135 | { 136 | if (index < 1) 137 | throw("domain_error: term arity"); 138 | if (TAG(term) == TAG_STR) 139 | { 140 | if (index > ftable[VAL(memory[VAL(term)])][1]) // Check arity is OK 141 | throw("type_error: term arity"); 142 | return memory[VAL(term) + index]; 143 | } 144 | throw("type_error: term"); 145 | } 146 | 147 | // Returns an object with head and tail keys 148 | function PL_get_list(list) 149 | { 150 | if (TAG(list) == TAG_LST) 151 | return {head: memory[VAL(list)], 152 | tail: memory[VAL(list)+1]}; 153 | return null; 154 | } 155 | 156 | function PL_get_head(list) 157 | { 158 | if (TAG(list) == TAG_LST) 159 | return memory[VAL(list)]; 160 | return null; 161 | } 162 | 163 | function PL_get_tail(list) 164 | { 165 | if (TAG(list) == TAG_LST) 166 | return memory[VAL(list)+1]; 167 | return null; 168 | } 169 | 170 | function PL_get_nil() 171 | { 172 | return NIL; 173 | } 174 | 175 | function PL_put_variable() 176 | { 177 | return alloc_var(); 178 | } 179 | 180 | function PL_put_atom(atom) 181 | { 182 | return atom; 183 | } 184 | 185 | function PL_put_atom_chars(chars) 186 | { 187 | return lookup_atom(chars); 188 | } 189 | 190 | function PL_put_integer(integer) 191 | { 192 | return integer ^ (TAG_INT << WORD_BITS); 193 | } 194 | 195 | function PL_put_functor(term, ftor) 196 | { 197 | var r = alloc_structure(ftor); 198 | for (i = 0; i < ftable[VAL(ftor)][1]; i++) 199 | alloc_var(); 200 | } 201 | 202 | function PL_put_list() 203 | { 204 | var r = alloc_list(); 205 | alloc_var(); 206 | alloc_var(); 207 | } 208 | 209 | function PL_put_nil() 210 | { 211 | return NIL; 212 | } 213 | 214 | function PL_cons_functor(ftor) 215 | { 216 | if (state.H + arguments.length + 1 >= HEAP_SIZE) 217 | return false; // Not enough heap 218 | var r = state.H ^ (TAG_STR << WORD_BITS); 219 | memory[state.H++] = ftor; 220 | for (i = 1; i < arguments.length; i++) 221 | memory[state.H++] = arguments[i]; 222 | } 223 | 224 | function PL_cons_list(head, tail) 225 | { 226 | if (state.H +2 >= HEAP_SIZE) 227 | return false; 228 | var result = state.H ^ (TAG_LST << WORD_BITS); 229 | memory[state.H++] = head; 230 | memory[state.H++] = tail; 231 | return result; 232 | } 233 | 234 | function PL_unify_integer(term, integer) 235 | { 236 | return unify(term, integer ^ (TAG_INT << WORD_BITS)); 237 | } 238 | 239 | function PL_unify_atom_chars(term, chars) 240 | { 241 | return unify(term, lookup_atom(string)); 242 | } 243 | 244 | function PL_unify(t1, t2) 245 | { 246 | return unify(t1, t2); 247 | } 248 | 249 | function PL_unify_atom(term, atom) 250 | { 251 | return unify(term, atom); 252 | } 253 | 254 | function PL_unify_nil(term) 255 | { 256 | return unify(term, NIL); 257 | } 258 | 259 | function PL_unify_arg(index, term, arg) 260 | { 261 | return unify(memory[VAL(term) + 1 + index], arg); 262 | } 263 | 264 | function PL_unify_list(list, head, tail) 265 | { 266 | return (TAG(list) == TAG_LST) && unify(memory[VAL(list)], head) && unify(memory[VAL(list) + 1], tail); 267 | } 268 | 269 | function PL_pred(ftor, module) 270 | { 271 | if (predicates[ftor] === undefined) 272 | throw("Undefined predicate"); 273 | return ftor; 274 | } 275 | 276 | function PL_predicate(name, arity, module) 277 | { 278 | return PL_pred(lookup_functor(name, arity), module); 279 | } 280 | 281 | function PL_open_query(module, debug, predicate, args) 282 | { 283 | initialize(); 284 | allocate_first_frame(); 285 | state.P = predicates[predicate]; 286 | for (i = 0; i < ftable[predicate][1]; i++) 287 | register[i] = args[i]; 288 | return {fresh:true}; 289 | } 290 | 291 | function PL_next_solution(qid) 292 | { 293 | if (!qid.fresh) 294 | backtrack(); 295 | qid.fresh = false; 296 | return wam(); 297 | } 298 | 299 | function PL_call(term, module) 300 | { 301 | ftor = VAL(memory[VAL(term)]); 302 | initialize(); 303 | allocate_first_frame(); 304 | state.P = predicates[ftor]; 305 | for (i = 0; i < ftable[ftor][1]; i++) 306 | register[i] = memory[VAL(term) + 1 + i]; 307 | return wam(); 308 | } 309 | 310 | function PL_cut_query(qid) 311 | { 312 | // This is not implemented 313 | } 314 | 315 | function PL_close_query(qid) 316 | { 317 | // This is not implemented either 318 | } 319 | 320 | 321 | function PL_call_predicate(module, debug, predicate, args) 322 | { 323 | var qid = PL_open_query(module, debug, predicate, args); 324 | var result = PL_next_solution(qid); 325 | PL_cut_query(qud); 326 | return result; 327 | } 328 | -------------------------------------------------------------------------------- /gc.js: -------------------------------------------------------------------------------- 1 | function predicate_gc() 2 | { 3 | debug("Before GC, heap is " + state.H); 4 | // WARNING: This assumes ONLY predicate_gc will mark things! 5 | total_marked = 0; 6 | 7 | // debugging only 8 | /* 9 | var before = []; 10 | var e = state.E; 11 | var envsize = state.CP.code[state.CP.offset - 1]; 12 | while (e != HEAP_SIZE) 13 | { 14 | for (var i = 0; i < envsize; i++) 15 | { 16 | debug_msg("Y"+ i + " = " + term_to_string(memory[e+2 + i]) + " (" + hex(memory[e+2+i]) + ") @ " + (e+2+i)); 17 | before.push(record_term(memory[e+2 + i])); 18 | } 19 | var envcp = memory[e+1]; 20 | envsize = envcp.code[envcp.offset-1]; 21 | e = memory[e]; 22 | } 23 | */ 24 | // check_stacks(false); 25 | mark(); 26 | // check_stacks(true); 27 | debug_msg("\n\nMarked " + total_marked + " cells. Starting sweep"); 28 | push_registers(); 29 | sweep_trail(); 30 | debug_msg("Trail swept: " + total_marked); 31 | sweep_stack(); 32 | 33 | debug_msg("\n\nMarked " + total_marked + " cells"); 34 | debug_msg("Stack swept"); 35 | debug_msg("Compacting heap"); 36 | 37 | compact(); 38 | pop_registers(); 39 | state.H = total_marked; 40 | debug("After GC, heap is " + state.H); 41 | 42 | // check_stacks(false); 43 | /* 44 | var after = []; 45 | var e = state.E; 46 | var envsize = state.CP.code[state.CP.offset - 1]; 47 | while (e != HEAP_SIZE) 48 | { 49 | for (var i = 0; i < envsize; i++) 50 | { 51 | debug_msg("Y"+ i + " = " + term_to_string(memory[e+2 + i]) + " (" + hex(memory[e+2+i]) + ") @ " + (e+2+i)); 52 | after.push(record_term(memory[e+2 + i])); 53 | } 54 | var envcp = memory[e+1]; 55 | envsize = envcp.code[envcp.offset-1]; 56 | e = memory[e]; 57 | } 58 | */ 59 | if (total_marked != 0) 60 | { 61 | debug_msg("Warning: Some objects were not unmarked: " + total_marked); 62 | } 63 | /* 64 | debug_msg("Comparing environments"); 65 | while (before.length != 0) 66 | { 67 | var a = before.pop(); 68 | var b = after.pop(); 69 | at = recall_term(a, {}); 70 | bt = recall_term(b, {}); 71 | if (!predicate_unify(at, bt)) 72 | { 73 | debug("Error: Terms in environment changed during GC!"); 74 | debug("at = " + term_to_string(at)); 75 | debug("bt = " + term_to_string(bt)); 76 | abort("false"); 77 | } 78 | debug_msg("Match: " + term_to_string(at) + " and " + term_to_string(bt)); 79 | } 80 | debug_msg("All values accounted for"); 81 | */ 82 | 83 | return true; 84 | } 85 | 86 | function push_registers() 87 | { 88 | for (var i = 0; i < state.num_of_args; i++) 89 | { 90 | memory[state.TR++] = register[i]; 91 | } 92 | } 93 | 94 | function pop_registers() 95 | { 96 | for (var i = state.num_of_args-1; i >= 0; i--) 97 | { 98 | register[i] = memory[--state.TR]; 99 | } 100 | } 101 | 102 | function sweep_trail() 103 | { 104 | for (var current = state.TR-1; current >= HEAP_SIZE + STACK_SIZE; current--) 105 | { 106 | if (IS_HEAP_PTR(memory[current])) 107 | { 108 | debug_msg("into_relocation_chain(" + VAL(memory[current]) + ", " + current + ")"); 109 | into_relocation_chain(VAL(memory[current]), current); 110 | } 111 | else 112 | { 113 | debug_msg("Not a heap pointer!"); 114 | } 115 | } 116 | } 117 | 118 | function sweep_stack() 119 | { 120 | sweep_environments(state.E, state.CP.code[state.CP.offset - 1]); 121 | debug_msg("Environments swept... " + hex(memory[0])); 122 | sweep_choicepoints(); 123 | debug_msg("Choicepoints swept"); 124 | } 125 | 126 | function sweep_environments(e, envsize) 127 | { 128 | while (e != HEAP_SIZE) 129 | { 130 | // Traversing backwards to ensure we do not stop prematurely 131 | debug_msg("Environment is " + e + " and initially envcp is " + memory[e+1] + " environment has " + envsize + " slots"); 132 | for (var y = envsize-1; y >= 0; y--) 133 | { 134 | if (IS_HEAP_PTR(memory[e+2 + y])) 135 | { 136 | if ((memory[e+2 + y] & M_BIT) == 0) 137 | { 138 | // we have already swept this chain 139 | debug_msg("Already swept this environment, since M_BIT is not set at " + (e+2+y) + " = " + hex(memory[e+2+y])); 140 | return; 141 | } 142 | else 143 | { 144 | memory[e+2 + y] &= ~M_BIT; 145 | debug_msg("Adding slot Y" + y + " (at " + (e+2+y) + ") to relocation chain. Present value is: " + hex(memory[e+2+y])); 146 | into_relocation_chain(VAL(memory[e+2+y]), e+2+y); 147 | } 148 | } 149 | } 150 | var envcp = memory[e+1]; 151 | debug_msg("envcp is at " + (e+1) +" and equals " + envcp); 152 | // work out the size of the previous environment, using the CP pointer saved in THIS environment. 153 | // This is why we had to pass size in to mark_environments() 154 | envsize = envcp.code[envcp.offset-1]; 155 | e = memory[e]; 156 | } 157 | } 158 | 159 | function sweep_choicepoints() 160 | { 161 | var b = state.B; 162 | while (b != 0) 163 | { 164 | var cpcp = memory[b + memory[b] + 2]; 165 | var envsize = cpcp.code[cpcp.offset-1]; 166 | sweep_environments(memory[b + memory[b] + 1], envsize); 167 | for (var y = 0; y < memory[b]; y++) 168 | { 169 | if (IS_HEAP_PTR(memory[b+y+1])) 170 | { 171 | debug_msg("Adding choicepoint value into relocation chain"); 172 | memory[b+y+1] &= ~M_BIT; 173 | into_relocation_chain(VAL(memory[b+y+1]), b+y+1); 174 | } 175 | } 176 | if ((memory[memory[b + memory[b] + 6]] & M_BIT) == 0) 177 | { 178 | // The choicepoint has a saved value for H (ie HB) which is not marked 179 | // Make a fake atom on the heap and change the HB to point to it 180 | memory[memory[b + memory[b] + 6]] = NIL ^ (M_BIT) 181 | total_marked++; 182 | } 183 | debug_msg("Adding HB into relocation chain... " + hex(memory[0])); 184 | into_relocation_chain(memory[b + memory[b] + 6], b + memory[b] + 6); 185 | b = memory[b + memory[b] + 3]; 186 | } 187 | } 188 | 189 | function mark() 190 | { 191 | mark_registers(); 192 | debug_msg("Registers done: " + total_marked); 193 | mark_environments(state.E, state.CP.code[state.CP.offset - 1]); 194 | debug_msg("Env done" + total_marked); 195 | mark_choicepoints(); 196 | debug_msg("Choicepoints done " + total_marked); 197 | } 198 | 199 | function compact() 200 | { 201 | var dest; 202 | var current; 203 | dest = total_marked - 1; 204 | debug_msg("Upward phase"); 205 | // Upward 206 | for (current = state.H-1; current >= 0; current--) 207 | { 208 | if ((memory[current] & M_BIT) == M_BIT) 209 | { 210 | update_relocation_chain(current, dest); 211 | if (IS_HEAP_PTR(memory[current])) 212 | { 213 | debug_msg("current->value ( " + hex(memory[current]) + ") is a pointer to heap address " + VAL(memory[current])); 214 | if (VAL(memory[current]) < current) 215 | { 216 | debug_msg("Adding to relocation chain: " + VAL(memory[current]) + ", " + current); 217 | into_relocation_chain(VAL(memory[current]), current); 218 | } 219 | else if (VAL(memory[current]) == current) 220 | { 221 | debug_msg("A cell pointing to itself. Must set the value to dest: " + dest); 222 | memory[current] = (memory[current] & NV_MASK) ^ dest; 223 | } 224 | } 225 | dest--; 226 | } 227 | } 228 | debug_msg("Downward phase"); 229 | 230 | // Downward 231 | dest = 0; 232 | for (current = 0; current < state.H; current++) 233 | { 234 | if ((memory[current] & M_BIT) == M_BIT) 235 | { 236 | update_relocation_chain(current, dest); 237 | if (IS_HEAP_PTR(memory[current]) && VAL(memory[current]) > current) 238 | { 239 | into_relocation_chain(VAL(memory[current]), dest); 240 | 241 | memory[dest] = VAL(memory[dest]) ^ (TAG(memory[current]) << WORD_BITS); 242 | } 243 | else 244 | { 245 | memory[dest] = memory[current]; 246 | // clear the GC flags 247 | memory[dest] &= ~F_BIT; 248 | } 249 | memory[dest] &= ~M_BIT; 250 | debug_msg("set memory[" + dest + "] to " + hex(memory[dest])); 251 | dest++; 252 | } 253 | } 254 | debug_msg("Complete. Total marked: " + total_marked); 255 | } 256 | 257 | function update_relocation_chain(current, dest) 258 | { 259 | var j; 260 | while ((memory[current] & F_BIT) == F_BIT) 261 | { 262 | debug_msg("Current: " + current + " has F bit set"); 263 | j = VAL(memory[current]); 264 | debug_msg("J is " + j + " which has value " + hex(memory[j])); 265 | memory[current] = VAL(memory[j]) ^ (memory[current] & (NV_MASK ^ F_BIT)) | (memory[j] & F_BIT); 266 | memory[j] = dest ^ (memory[j] & NV_MASK); 267 | memory[j] &= ~F_BIT; 268 | debug_msg("memory[" + j + "] <- " + hex(memory[j])); 269 | debug_msg("memory[" + current + "] <- " + hex(memory[current])); 270 | } 271 | } 272 | 273 | function into_relocation_chain(j, current) 274 | { 275 | memory[current] = VAL(memory[j]) ^ (memory[current] & (NV_MASK ^ F_BIT)) | (memory[j] & F_BIT); 276 | memory[j] = current ^ (memory[j] & NV_MASK); 277 | memory[j] |= F_BIT; 278 | } 279 | 280 | function IS_HEAP_PTR(x) 281 | { 282 | var tag = TAG(x); 283 | return (tag == TAG_STR || tag == TAG_LST || tag == TAG_REF) && (VAL(x) < HEAP_SIZE); 284 | } 285 | 286 | // Mark all the cells reachable from the registers as reachable (ie set their M bits) 287 | function mark_registers() 288 | { 289 | for (var i = 0; i < state.num_of_args; i++) 290 | { 291 | if (IS_HEAP_PTR(register[i])) 292 | { 293 | // register refers to the heap. We have to temporarily put this onto the heap since mark_variable 294 | // expects an address (ie an index into memory[]) and register[i] 295 | var tmp = state.H; 296 | if (state.H == HEAP_SIZE) 297 | abort("Out of heap during GC"); 298 | memory[state.H++] = register[i]; 299 | mark_variable(tmp); 300 | state.H--; // We can just clean it up now, since mark_variable is not allowed to write to memory[] 301 | } 302 | } 303 | } 304 | 305 | // Mark all the cells reachable from the environment 'initial'. 306 | // Note that this takes into account LCO: Trimmed cells are ignored. 307 | // If these are actually needed, mark_choicepoints() will find them 308 | function mark_environments(initial, envsize) 309 | { 310 | var e = initial; 311 | while (e != HEAP_SIZE) 312 | { 313 | debug_msg("Marking environment " + e + " which has " + envsize + " slots"); 314 | // Traversing backwards to ensure we do not stop prematurely 315 | for (var y = envsize-1; y >= 0; y--) 316 | { 317 | if ((memory[e+2 + y] & M_BIT) == M_BIT) 318 | { 319 | // we have already done this chain 320 | debug_msg("Slot is already marked. Stopping marking"); 321 | return; 322 | } 323 | else if (IS_HEAP_PTR(memory[e+2 + y])) 324 | { 325 | // Y-register refers to the heap 326 | debug_msg("Marking environment slot " + y + " = " + hex(memory[e+2+y]) + " (" + term_to_string(memory[e+2+y]) + ")"); 327 | mark_variable(e+2 + y); 328 | debug_msg("###memory[" + (e+2+y) + "] = " + hex(memory[e+2+y])); 329 | } 330 | else 331 | { 332 | debug_msg("Is not a heap ptr: " + hex(memory[e+2+y])); 333 | } 334 | } 335 | var envcp = memory[e+1]; 336 | // work out the size of the previous environment, using the CP pointer saved in THIS environment. 337 | // This is why we had to pass size in to mark_environments() 338 | debug_msg("e->CE is " + memory[e]); 339 | debug_msg("e->CP is at " + (e+1) + " and is " + envcp); 340 | envsize = envcp.code[envcp.offset-1]; 341 | e = memory[e]; 342 | } 343 | } 344 | 345 | function mark_choicepoints() 346 | { 347 | var b = state.B; 348 | while (b != 0) 349 | { 350 | var cpcp = memory[b + memory[b] + 2]; 351 | var envsize = cpcp.code[cpcp.offset-1]; 352 | mark_environments(memory[b + memory[b] + 1], envsize); 353 | for (var y = 0; y < memory[b]; y++) 354 | { 355 | if (IS_HEAP_PTR(memory[b+y+1])) 356 | { 357 | // Y-register refers to the heap 358 | debug_msg("Marking B value " + (b+y+1)); 359 | mark_variable(b + y + 1); 360 | } 361 | } 362 | b = memory[b + memory[b] + 3]; 363 | } 364 | } 365 | 366 | var total_marked = 0; 367 | 368 | // start is an address: That is, an index into memory[]. It is NOT a cell, so it does NOT have a tag! 369 | // Also, it must be the address of something which is a pointer. That is, VAL(memory[start]) must be another index into memory[]. 370 | function mark_variable(start) 371 | { 372 | debug_msg("\nMarking: " + start); 373 | current = start; 374 | next = VAL(memory[current]); 375 | memory[current] |= F_BIT; 376 | debug_msg("Set F on " + current); 377 | // mark_variable is always called with something which is either not on the heap 378 | // or not /really/ on the heap, in the case of register values. Therefore, when we count 379 | // the first thing, we should increment total_marked to 0, not 1. 380 | total_marked--; 381 | 382 | while(true) // unwrap goto into while loops 383 | { 384 | while (true) // forward 385 | { 386 | debug_msg("Forward. (" + current + ", " + next + ")"); 387 | if ((memory[current] & M_BIT) == M_BIT) 388 | break; // goto backward 389 | debug_msg("Set M on " + current); 390 | memory[current] |= M_BIT; 391 | total_marked++; 392 | debug_msg("Total marked is now " + total_marked); 393 | switch(TAG(memory[current])) 394 | { 395 | case TAG_REF: // Transformation 1 396 | if ((memory[next] & F_BIT) == F_BIT) 397 | { 398 | break; // goto backward 399 | } 400 | // REVERSE(current, next); 401 | debug_msg("REVERSE(" + current + ", " + next + ")"); 402 | var temp = VAL(memory[next]); 403 | var tag = TAG(memory[next]); 404 | memory[next] = (memory[next] & NV_MASK) ^ current; 405 | current = next; 406 | next = temp; 407 | continue; // goto forward 408 | case TAG_STR: // Transform 2a 409 | case TAG_LST: // Transform 2b 410 | if ((memory[next+1] & F_BIT) == F_BIT) 411 | break; // goto backward 412 | // Optimisation: We can skip the structure if we have already marked all its arguments 413 | // FIXME: Implement 414 | 415 | if (TAG(memory[current]) == TAG_STR) 416 | { 417 | var i; 418 | for (i = 0; i < ftable[VAL(memory[next])][1]; i++) 419 | { 420 | debug_msg("Set F on " + (next+1+i)); 421 | memory[next+1+i] |= F_BIT; 422 | } 423 | next = next+i; 424 | } 425 | else 426 | { 427 | debug_msg("Set F on " + (next+1)); 428 | memory[next+1] |= F_BIT; 429 | next = next+1; 430 | } 431 | debug_msg("REVERSE(" + current + ", " + next + ")"); 432 | //REVERSE(current, next); 433 | var temp = VAL(memory[next]); 434 | memory[next] = (memory[next] & NV_MASK) ^ current; 435 | current = next; 436 | next = temp; 437 | 438 | continue; // goto forward 439 | default: 440 | // All other types: INT, ATM, FLT, etc 441 | // Transformation 3 442 | break; // goto backward 443 | } 444 | break; // if we get to the end of forward, we must be wanting to go to backward 445 | } 446 | while (true) // backward 447 | { 448 | debug_msg("Backward (" + current + ", " + next + ")"); 449 | if ((memory[current] & F_BIT) != F_BIT) 450 | { 451 | // current is an internal cell 452 | // Transformation 4 453 | //UNDO(current, next); 454 | debug_msg("UNDO(" + current + ", " + next + ")"); 455 | var temp = VAL(memory[current]); 456 | var tag = TAG(memory[next]); 457 | memory[current] = (memory[current] & NV_MASK) ^ next; 458 | next = current; 459 | current = temp; 460 | continue; // goto backward 461 | } 462 | // current is the head of a chain 463 | debug_msg("Unset F on " + current); 464 | memory[current] &= ~F_BIT; 465 | if (current == start) 466 | { 467 | // current is the head of the chain we started with. Finished! 468 | return; 469 | } 470 | // Otherwise, current is the head of a subchain 471 | current--; // Transformation 5 472 | //ADVANCE(current, next); 473 | debug_msg("ADVANCE(" + current + ", " + next + ")"); 474 | var temp = VAL(memory[current+1]); 475 | memory[current+1] = (memory[current+1] & NV_MASK) ^ next; 476 | next = VAL(memory[current]); 477 | memory[current] = (memory[current] & NV_MASK) ^ temp; 478 | break; // goto forward 479 | } 480 | } 481 | } 482 | 483 | 484 | 485 | function gc_test(d) 486 | { 487 | debugging = d; 488 | load_state(); 489 | initialize(); 490 | stdout("Loaded " + Object.keys(predicates).length + " predicates"); 491 | stdout("Loaded " + atable.length + " atoms"); 492 | stdout("Loaded " + ftable.length + " functors"); 493 | stdout("Loaded " + code.length + " bytes of code"); 494 | 495 | memory[0] = 0x20000088; 496 | memory[1] = 0x20000071; 497 | memory[2] = 0x20000072; 498 | state.H = 3; 499 | state.CP.code[state.CP.offset - 1] = 1; 500 | memory[state.E + 2] = 0x8000000; 501 | debug_msg("Y0 = " + hex(memory[state.E+2])); 502 | debug_msg(" -> " + term_to_string(memory[state.E+2])); 503 | mark_variable(state.E+2); 504 | debug_msg("Marked " + total_marked); 505 | 506 | compact(); 507 | debug_msg("Y0 = " + hex(memory[state.E+2])); 508 | debug_msg(" -> " + term_to_string(memory[state.E+2])); 509 | } 510 | 511 | function dump_heap() 512 | { 513 | debug_msg("Heap:-----------------------"); 514 | for (var i = 0; i < state.H; i++) 515 | { 516 | debug_msg(i + ": " + hex(memory[i])); 517 | } 518 | debug_msg("----------------------------"); 519 | } 520 | 521 | function dump_registers() 522 | { 523 | debug_msg("Registers:------------------"); 524 | for (var i = 0; i < state.num_of_args; i++) 525 | { 526 | debug_msg(i + ": " + hex(register[i]) + " => " + term_to_string(register[i])); 527 | } 528 | debug_msg("----------------------------"); 529 | } 530 | 531 | 532 | function predicate_statistics() 533 | { 534 | stdout("Heap size: " + state.H + "\n"); 535 | return true; 536 | } 537 | 538 | function gc_check(t) 539 | { 540 | if (t & M_BIT) 541 | abort("GC exception: " + hex(t) + " has M_BIT set"); 542 | } 543 | 544 | function check_stacks(m) 545 | { 546 | debug_msg("Checking stacks " + m); 547 | check_environments(state.E, state.CP.code[state.CP.offset - 1], m); 548 | debug_msg("Stacks OK"); 549 | } 550 | 551 | function check_environments(initial, envsize, m) 552 | { 553 | var e = initial; 554 | while (e != HEAP_SIZE) 555 | { 556 | // Traversing backwards to ensure we do not stop prematurely 557 | debug_msg("Checking environment " + e); 558 | for (var y = 0; y < envsize; y++) 559 | { 560 | if (TAG(memory[e+2+y]) == TAG_STR || 561 | TAG(memory[e+2+y]) == TAG_LST) 562 | { 563 | debug_msg("Checking Y" + y); 564 | check_term(memory[e+2+y], m); 565 | } 566 | else 567 | { 568 | debug_msg("Y" + y + " is not a heap pointer"); 569 | } 570 | // Otherwise we do not need to check it if it is in the environment 571 | } 572 | var envcp = memory[e+1]; 573 | // work out the size of the previous environment, using the CP pointer saved in THIS environment. 574 | // This is why we had to pass size in to mark_environments() 575 | envsize = envcp.code[envcp.offset-1]; 576 | e = memory[e]; 577 | } 578 | } 579 | 580 | function check_term(t, m) 581 | { 582 | debug_msg("Checking " + hex(t)); 583 | if (!m) 584 | { 585 | debug_msg(" == " + term_to_string(t)); 586 | } 587 | if ((t & M_BIT) == M_BIT) 588 | { 589 | if (!m) 590 | abort("Term " + hex(t) + " is marked but should not be"); 591 | } 592 | else if (m) 593 | { 594 | abort("Term " + hex(t) + " is not marked but is reachable"); 595 | } 596 | if ((t & F_BIT) == F_BIT) 597 | { 598 | if (!m) 599 | abort("Term " + hex(t) + " is F but should not be"); 600 | } 601 | 602 | if (TAG(t) == TAG_LST) 603 | { 604 | if (VAL(t) > state.H) 605 | abort("Term " + hex(t) + " exceeds heap: " + state.H); 606 | check_term(memory[VAL(t)], m); 607 | check_term(memory[VAL(t)+1], m); 608 | } 609 | else if (TAG(t) == TAG_STR) 610 | { 611 | if (VAL(t) > state.H) 612 | abort("Term " + hex(t) + " exceeds heap: " + state.H); 613 | if (ftable[VAL(memory[VAL(t)])] == undefined) 614 | abort("Illegal functor " + VAL(memory[VAL(t)])); 615 | var arity = ftable[VAL(memory[VAL(t)])][1]; 616 | for (var i = 0; i < arity; i++) 617 | check_term(memory[VAL(t)+1+i], m); 618 | } 619 | // Everything else we assume is OK 620 | } 621 | -------------------------------------------------------------------------------- /js_preprocess.pl: -------------------------------------------------------------------------------- 1 | preprocess(Files, Outfile, Defines):- 2 | setup_call_cleanup(open(Outfile, write, OutStream), 3 | preprocess_1(Files, OutStream, Defines), 4 | close(OutStream)). 5 | 6 | preprocess_1([], _OutStream, _Defines):- !. 7 | preprocess_1([File|Files], OutStream, Defines):- 8 | setup_call_cleanup(open(File, read, InStream), 9 | ( format(OutStream, '// File ~w~n', [File]), 10 | preprocess_2(InStream, OutStream, Defines) 11 | ), 12 | close(InStream)), 13 | preprocess_1(Files, OutStream, Defines). 14 | 15 | 16 | preprocess_2(InStream, _OutStream, _Defines):- 17 | at_end_of_stream(InStream), !. 18 | 19 | preprocess_2(InStream, OutStream, Defines):- 20 | read_line_to_codes(InStream, Codes), 21 | ( Codes = [35, 105, 102|If]-> 22 | process_directive(InStream, If, Defines) 23 | ; Codes == [35, 101, 110, 100, 105, 102] -> % endif 24 | true 25 | ; codes_contain_debug_statement(Codes, [])-> 26 | ( memberchk(debug=true, Defines)-> 27 | format(OutStream, '~s~n', [Codes]) 28 | ; otherwise-> 29 | true 30 | ) 31 | ; otherwise-> 32 | format(OutStream, '~s~n', [Codes]) 33 | ), 34 | preprocess_2(InStream, OutStream, Defines). 35 | 36 | process_directive(InStream, IfCodes, Defines):- 37 | atom_codes(IfCodes, IfAtom), 38 | ( memberchk(IfAtom=true, Defines)-> 39 | % Accept directive 40 | true 41 | ; otherwise-> 42 | consume_file(InStream, 1) 43 | ). 44 | 45 | consume_file(_InStream, 0):- !. 46 | 47 | consume_file(InStream, N):- 48 | ( at_end_of_stream(InStream)-> 49 | throw(eof_in_macro) 50 | ; otherwise-> 51 | true 52 | ), 53 | read_line_to_codes(InStream, Codes), 54 | ( Codes == [35, 101, 110, 100, 105, 102]-> % endif 55 | NN is N-1 56 | ; Codes = [35, 105, 102|_]-> % Another if 57 | NN is N+1 58 | ; otherwise-> 59 | NN = N 60 | ), 61 | consume_file(InStream, NN). 62 | 63 | 64 | ... --> []|[_],... . 65 | codes_contain_debug_statement--> 66 | "function debug_msg(msg)", !, {fail}. 67 | codes_contain_debug_statement--> 68 | ..., "debug_msg(", ... . 69 | -------------------------------------------------------------------------------- /opcodes.pl: -------------------------------------------------------------------------------- 1 | %-------------------------------------- SWI-Only -------------------- 2 | :-dynamic(ftable/2). % functors 3 | :-dynamic(atable/2). % atoms 4 | :-dynamic(ptable/2). % predicates 5 | :-dynamic(fptable/2). % foreign predicates 6 | 7 | lookup_functor(Functor/Arity, N):- 8 | lookup_atom(Functor, F), 9 | ( ftable(F/Arity, N)-> 10 | true 11 | ; otherwise-> 12 | flag(ftable, N, N+1), 13 | assert(ftable(F/Arity, N)) 14 | ). 15 | 16 | lookup_atom(Atom, N):- 17 | ( atable(Atom, N)-> 18 | true 19 | ; otherwise-> 20 | flag(atable, N, N+1), 21 | assert(atable(Atom, N)) 22 | ). 23 | 24 | add_predicate(Predicate, N):- 25 | assert(ptable(Predicate, N)). 26 | 27 | quote_atom_for_javascript(Atom, QuotedAtom):- 28 | atom_codes(Atom, Codes), 29 | quote_atom_for_javascript_1(QuotedCodes, Codes, []), 30 | atom_codes(QuotedAtom, QuotedCodes). 31 | 32 | quote_atom_for_javascript_1([34|Codes])--> 33 | quote_atom_for_javascript_2(Codes). 34 | 35 | quote_atom_for_javascript_2([92, 110|Codes])--> 36 | "\n", !, 37 | quote_atom_for_javascript_2(Codes). 38 | 39 | quote_atom_for_javascript_2([92, 34|Codes])--> 40 | [34], !, % ' 41 | quote_atom_for_javascript_2(Codes). 42 | 43 | quote_atom_for_javascript_2([Code|Codes])--> 44 | [Code], 45 | quote_atom_for_javascript_2(Codes). 46 | 47 | quote_atom_for_javascript_2([34], [], []):- !. 48 | 49 | 50 | dump_tables(S):- 51 | ( setof(N-Atom, atable(Atom, N), Atoms)-> true ; otherwise-> Atoms = []), 52 | findall(QuotedAtom, 53 | ( member(_-Atom, Atoms), 54 | quote_atom_for_javascript(Atom, QuotedAtom) 55 | ), 56 | SortedAtoms), 57 | atomic_list_concat(SortedAtoms, ', ', AtomAtom), 58 | format(S, 'atable = [~w];~n', [AtomAtom]), 59 | ( setof(N-F, ftable(F, N), Functors)-> true ; otherwise-> Functors = []), 60 | findall(Functor, (member(_-F/A, Functors), 61 | format(atom(Functor), '[~w,~w]', [F, A])), 62 | SortedFunctors), 63 | atomic_list_concat(SortedFunctors, ', ', FunctorAtom), 64 | format(S, 'ftable = [~w];~n', [FunctorAtom]), 65 | findall(PredicateAtom, 66 | ( ptable(Predicate, N), 67 | format(atom(PredicateAtom), '~w: ~w', [Predicate, N]) 68 | ), 69 | Predicates), 70 | atomic_list_concat(Predicates, ', ', PredicatesAtom), 71 | format(S, 'predicates = {~w};~n', [PredicatesAtom]), 72 | findall(PredicateAtom, 73 | ( fptable(Predicate, Symbol), 74 | format(atom(PredicateAtom), '~w: ~w', [Predicate, Symbol]) 75 | ), 76 | FPredicates), 77 | atomic_list_concat(FPredicates, ', ', FPredicatesAtom), 78 | format(S, 'foreign_predicates = {~w};~n', [FPredicatesAtom]). 79 | 80 | 81 | reserve_predicate(Functor, Foreign):- 82 | lookup_functor(Functor, F), 83 | assert(fptable(F, Foreign)). 84 | 85 | 86 | reset:- 87 | retractall(ptable(_,_)), 88 | retractall(atable(_,_)), 89 | retractall(ftable(_,_)), 90 | retractall(fptable(_,_)), 91 | % [] is always 0 92 | assert(atable([], 0)), 93 | 94 | flag(ftable, _, 0), 95 | flag(atable, _, 1), 96 | 97 | % Then add in some reserved predicates 98 | reserve_predicate(is/2, predicate_is), 99 | %reserve_predicate((>)/2, predicate_gt), 100 | %reserve_predicate((<)/2, predicate_lt), 101 | reserve_predicate(fail/0, predicate_fail), 102 | reserve_predicate(true/0, predicate_true), 103 | %reserve_predicate((=:=)/2, predicate_numeq), 104 | reserve_predicate(!/0, predicate_cut), 105 | reserve_predicate(term_variables/2, term_variables), 106 | reserve_predicate(writeln/1, writeln), 107 | reserve_predicate((=)/2, predicate_unify), 108 | reserve_predicate(halt/0, halt), 109 | reserve_predicate((=..)/2, univ), 110 | reserve_predicate((==)/2, predicate_match), 111 | reserve_predicate(functor/3, functor), 112 | reserve_predicate(var/1, predicate_var), 113 | reserve_predicate(atom/1, predicate_atom), 114 | reserve_predicate(integer/1, predicate_integer), 115 | 116 | % The big guns! 117 | reserve_predicate(atom_to_memory_file/2, atom_to_memory_file), 118 | reserve_predicate(open_memory_file/3, open_memory_file), 119 | reserve_predicate(read_term/3, read_term), 120 | reserve_predicate(close/1, predicate_close), 121 | reserve_predicate(free_memory_file/1, free_memory_file), 122 | true. 123 | 124 | 125 | 126 | %--------------------------------------------------------------------- 127 | 128 | -------------------------------------------------------------------------------- /read.js: -------------------------------------------------------------------------------- 1 | /* Term reading */ 2 | // See http://journal.stuffwithstuff.com/2011/03/19/pratt-parsers-expression-parsing-made-easy/ 3 | // Parsers return either: 4 | // 1) An string, in case of an atom 5 | // 2) An integer, in case of an integer 6 | // 3) An object with .list and .tail if a list (because apparently it is not easy to determine if the type of something is a list at runtime!?) 7 | // If it is a proper list, .tail == NIL 8 | // 4) An object with .variable_name, if a variable 9 | // 5) An object with .functor (a string) and .args (an array) defined if a term 10 | 11 | function parse_infix(s, lhs, precedence) 12 | { 13 | var token = {}; 14 | if (!read_token(s, token)) 15 | return false; 16 | token = token.value; 17 | var rhs = {}; 18 | if (!read_expression(s, precedence, false, false, rhs)) 19 | return false; 20 | return {functor: token, 21 | args: [lhs, rhs.value]}; 22 | } 23 | 24 | function parse_postfix(s, lhs) 25 | { 26 | var token = {}; 27 | if (!read_token(s, token)) 28 | return false; 29 | return {functor: token.value, 30 | args: [lhs]}; 31 | } 32 | 33 | // A reminder: yfx means an infix operator f, with precedence p, where the lhs has a precendece <= p and the rhs has a precedence < p. 34 | 35 | var prefix_operators = {":-": {precedence: 1200, fixity: "fx"}, 36 | "?-": {precedence: 1200, fixity: "fx"}, 37 | "dynamic": {precedence: 1150, fixity: "fx"}, 38 | "discontiguous": {precedence: 1150, fixity: "fx"}, 39 | "initialization": {precedence: 1150, fixity: "fx"}, 40 | "meta_predicate": {precedence: 1150, fixity: "fx"}, 41 | "module_transparent": {precedence: 1150, fixity: "fx"}, 42 | "multifile": {precedence: 1150, fixity: "fx"}, 43 | "thread_local": {precedence: 1150, fixity: "fx"}, 44 | "volatile": {precedence: 1150, fixity: "fx"}, 45 | "\+": {precedence: 900, fixity: "fy"}, 46 | "~": {precedence: 900, fixity: "fx"}, 47 | "?": {precedence: 500, fixity: "fx"}, 48 | "+": {precedence: 200, fixity: "fy"}, 49 | "-": {precedence: 200, fixity: "fy"}, 50 | "\\": {precedence: 200, fixity: "fy"}}; 51 | 52 | 53 | var infix_operators = {":-": {precedence: 1200, fixity: "xfx"}, 54 | "-->": {precedence: 1200, fixity: "xfx"}, 55 | ";": {precedence: 1100, fixity: "xfy"}, 56 | "|": {precedence: 1100, fixity: "xfy"}, 57 | "->": {precedence: 1050, fixity: "xfy"}, 58 | "*->": {precedence: 1050, fixity: "xfy"}, 59 | ",": {precedence: 1000, fixity: "xfy"}, 60 | ":=": {precedence: 990, fixity: "xfx"}, 61 | "<": {precedence: 700, fixity: "xfx"}, 62 | "=": {precedence: 700, fixity: "xfx"}, 63 | "=..": {precedence: 700, fixity: "xfx"}, 64 | "=@=": {precedence: 700, fixity: "xfx"}, 65 | "=:=": {precedence: 700, fixity: "xfx"}, 66 | "=<": {precedence: 700, fixity: "xfx"}, 67 | "==": {precedence: 700, fixity: "xfx"}, 68 | "=\=": {precedence: 700, fixity: "xfx"}, 69 | ">": {precedence: 700, fixity: "xfx"}, 70 | ">=": {precedence: 700, fixity: "xfx"}, 71 | "@<": {precedence: 700, fixity: "xfx"}, 72 | "@=<": {precedence: 700, fixity: "xfx"}, 73 | "@>": {precedence: 700, fixity: "xfx"}, 74 | "@>=": {precedence: 700, fixity: "xfx"}, 75 | "\=": {precedence: 700, fixity: "xfx"}, 76 | "\==": {precedence: 700, fixity: "xfx"}, 77 | "is": {precedence: 700, fixity: "xfx"}, 78 | ">:<": {precedence: 700, fixity: "xfx"}, 79 | ":<": {precedence: 700, fixity: "xfx"}, 80 | ":": {precedence: 600, fixity: "xfy"}, 81 | "+": {precedence: 500, fixity: "yfx"}, 82 | "-": {precedence: 500, fixity: "yfx"}, 83 | "/\\": {precedence: 500, fixity: "yfx"}, 84 | "\\/": {precedence: 500, fixity: "yfx"}, 85 | "xor": {precedence: 500, fixity: "yfx"}, 86 | "*": {precedence: 400, fixity: "yfx"}, 87 | "/": {precedence: 400, fixity: "yfx"}, 88 | "//": {precedence: 400, fixity: "yfx"}, 89 | "rdiv": {precedence: 400, fixity: "yfx"}, 90 | "<<": {precedence: 400, fixity: "yfx"}, 91 | ">>": {precedence: 400, fixity: "yfx"}, 92 | "mod": {precedence: 400, fixity: "yfx"}, 93 | "rem": {precedence: 400, fixity: "yfx"}, 94 | "**": {precedence: 200, fixity: "xfx"}, 95 | "^": {precedence: 200, fixity: "xfy"}}; 96 | 97 | // This returns a javascript object representation of the term. It takes the two extra args because of some oddities with Prolog: 98 | // 1) If we are reading foo(a, b) and we are at the a, we would accept the , as part of the LHS. ie, we think (a,b) is the sole argument. Instead, we should make , have 99 | // very high precedence if we are reading an arg. Of course, () can reduce this again, so that foo((a,b)) does indeed read ,(a,b) as the single argument 100 | // 2) | behaves slightly differently in lists, in a similar sort of way 101 | function read_expression(s, precedence, isarg, islist, expression) 102 | { 103 | var token = {}; 104 | if (!read_token(s, token)) 105 | return false; 106 | token = token.value; 107 | if (token == null) 108 | { 109 | expression.value = {end_of_file:true}; 110 | return true; 111 | } 112 | var lhs; 113 | // Either the token is an operator, or it must be an atom (or the start of a list or curly-list) 114 | var op = prefix_operators[token]; 115 | if (op === undefined) 116 | { 117 | if (token == "\"") 118 | { 119 | // We have to just read chars until we get a close " (taking care with \" in the middle) 120 | var args = []; 121 | var t = 0; 122 | var mode = 0; 123 | if (prolog_flag_values['double_quotes'] == "chars") 124 | mode = 0; 125 | else if (prolog_flag_values['double_quotes'] == "codes") 126 | mode = 1; 127 | else if (prolog_flag_values['double_quotes'] == "atom") 128 | mode = 2; 129 | while (true) 130 | { 131 | t = get_raw_char_with_conversion(s.stream); 132 | if (t == '"') 133 | break; 134 | if (t == "\\") 135 | { 136 | if (peek_raw_char_with_conversion(s.stream) == '"') 137 | { 138 | get_raw_char_with_conversion(s.stream); 139 | if (mode == 1) 140 | args.push('"'.charCodeAt(0)); 141 | else 142 | args.push('"'); 143 | continue; 144 | } 145 | } 146 | if (mode == 1) 147 | args.push(t.charCodeAt(0)); 148 | else 149 | args.push(t); 150 | } 151 | if (mode == 2) 152 | lhs = args.join(''); 153 | else 154 | lhs = {list: args, tail: "[]"}; 155 | } 156 | else if (token == "[" || token == "{") 157 | { 158 | // The principle for both of these is very similar 159 | var args = []; 160 | var next = {}; 161 | while(true) 162 | { 163 | var t = {}; 164 | if (!read_expression(s, Infinity, true, true, t)) 165 | return false; 166 | t = t.value; 167 | if (t == "]") 168 | { 169 | lhs = "[]"; 170 | break; 171 | // Special case for the empty list, since the first argument is ']' 172 | } 173 | args.push(t); 174 | next = {}; 175 | if (!read_token(s, next)) 176 | return false; 177 | next = next.value; 178 | if (next == ',') 179 | continue; 180 | else if (next == "]" && token == "[") 181 | { 182 | lhs = {list: args, tail: "[]"}; 183 | break; 184 | } 185 | else if (next == "}" && token == "{") 186 | { 187 | lhs = {functor: "{}", args:args}; 188 | break; 189 | } 190 | else if (next == "|" && token == "[") 191 | { 192 | var tail = {}; 193 | if (!read_expression(s, Infinity, true, true, tail)) 194 | return false; 195 | lhs = {list: args, tail: tail.value}, 196 | next = {}; 197 | if (!read_token(s, next)) 198 | return false; 199 | next = next.value; 200 | if (next == "]") 201 | break; 202 | else 203 | return syntax_error("missing ]"); 204 | } 205 | else 206 | { 207 | return syntax_error("mismatched " + token + " at " + next); 208 | } 209 | } 210 | } 211 | else if (token == "(") 212 | { 213 | // Is this right? () just increases the precedence to infinity and reads another term? 214 | var lhs = {}; 215 | if (!read_expression(s, Infinity, false, false, lhs)) 216 | return false; 217 | lhs = lhs.value; 218 | next = {}; 219 | if (!read_token(s, next)) 220 | return false; 221 | next = next.value; 222 | if (next != ")") 223 | return syntax_error("mismatched ( at " + next); 224 | } 225 | else if (token == "]") 226 | { 227 | expression.value = token; 228 | return true; 229 | } 230 | else 231 | { 232 | // It is an atom 233 | lhs = token; 234 | } 235 | } 236 | else if (op.fixity == "fx") 237 | { 238 | var arg = {}; 239 | if (!read_expression(s, op.precedence, isarg, islist, arg)) 240 | return false; 241 | lhs = {functor: token, args:[arg.value]}; 242 | } 243 | else if (op.fixity == "fy") 244 | { 245 | var arg = {}; 246 | if (!read_expression(s, op.precedence+0.5, isarg, islist, arg)) 247 | return false; 248 | lhs = {functor: token, args:[arg.value]}; 249 | } 250 | else 251 | return false; // Parse error 252 | while (true) 253 | { 254 | var infix_operator = {}; 255 | if (!peek_token(s, infix_operator)) 256 | return false; 257 | infix_operator = infix_operator.value; 258 | if (typeof(infix_operator) == "number" && infix_operator <= 0) 259 | { 260 | // Yuck. This is when we read something like X is A-1. Really the - is -/2 in this case 261 | read_token(s, {}); 262 | unread_token(s, Math.abs(infix_operator)); 263 | unread_token(s, "-"); 264 | infix_operator = "-"; 265 | } 266 | if (infix_operator == '(') 267 | { 268 | // We are reading a term. Keep reading expressions: After each one we should 269 | // either get , or ) 270 | // First though, consume the ( 271 | read_token(s, {}); 272 | var args = []; 273 | var next = {}; 274 | while (true) 275 | { 276 | var arg = {}; 277 | if (!read_expression(s, Infinity, true, false, arg)) 278 | return false; 279 | args.push(arg.value); 280 | next = {}; 281 | if (!read_token(s, next)) 282 | return false; 283 | next = next.value; 284 | if (next == ')') 285 | break; 286 | else if (next == ',') 287 | continue; 288 | else 289 | { 290 | if (next == null) 291 | return syntax_error("end_of_file"); 292 | else 293 | return syntax_error(next); 294 | } 295 | } 296 | // ./2 is a list 297 | if (lhs == "." && args.length == 2) 298 | { 299 | lhs = {list: args[0], 300 | tail: args[1]}; 301 | } 302 | else 303 | { 304 | lhs = {functor: lhs, 305 | args:args}; 306 | } 307 | // Now, where were we? 308 | infix_operator = {}; 309 | if (!peek_token(s, infix_operator)) 310 | return false; 311 | infix_operator = infix_operator.value; 312 | } 313 | // Pretend that . is an operator with infinite precedence 314 | if (infix_operator == ".") 315 | { 316 | expression.value = lhs; 317 | return true; 318 | } 319 | if (infix_operator == "," && isarg) 320 | { 321 | expression.value = lhs; 322 | return true; 323 | } 324 | if (infix_operator == "|" && islist) 325 | { 326 | expression.value = lhs; 327 | return true; 328 | } 329 | if (infix_operator == null) 330 | { 331 | expression.value = lhs; 332 | return true; 333 | } 334 | op = infix_operators[infix_operator]; 335 | if (op !== undefined) 336 | { 337 | if (op.fixity == "xfx" && precedence > op.precedence) 338 | { 339 | lhs = parse_infix(s, lhs, op.precedence); 340 | if (lhs == false) 341 | return false; 342 | } 343 | else if (op.fixity == "xfy" && precedence > op.precedence) 344 | { 345 | // Is this 0.5 thing right? Will it eventually drive up precedence to the wrong place? We never want to reach the next integer... 346 | lhs = parse_infix(s, lhs, op.precedence+0.5); 347 | if (lhs == false) 348 | return false; 349 | } 350 | else if (op.fixity == "yfx" && precedence >= op.precedence) 351 | { 352 | lhs = parse_infix(s, lhs, op.precedence); 353 | if (lhs == false) 354 | return false; 355 | } 356 | else if (op.fixity == "xf" && precedence > op.precedence) 357 | { 358 | lhs = parse_postfix(s, lhs, op.precedence); 359 | if (lhs == false) 360 | return false; 361 | } 362 | else if (op.fixity == "yf" && precedence >= op.precedence) 363 | { 364 | lhs = parse_postfix(s, lhs, op.precedence); 365 | if (lhs == false) 366 | return false; 367 | } 368 | else 369 | { 370 | expression.value = lhs; 371 | return true; 372 | } 373 | } 374 | else 375 | { 376 | expression.value = lhs; 377 | return true; 378 | } 379 | } 380 | } 381 | 382 | function parse_term_options(options) 383 | { 384 | var result = {}; 385 | var yes = lookup_atom("true"); 386 | while (options != NIL) 387 | { 388 | if (TAG(options) != TAG_LST) 389 | return type_error("list", options); 390 | var head = memory[VAL(options)]; 391 | if (TAG(head) != TAG_STR) 392 | return type_error("option", head); 393 | var ftor = memory[VAL(head)]; 394 | if (ftor == lookup_functor("quoted",1)) 395 | { 396 | result.quoted = (memory[VAL(head)+1] == yes) 397 | } 398 | else if (ftor == lookup_functor("ignore_ops",1)) 399 | { 400 | result.ignore_ops = (memory[VAL(head)+1] == yes) 401 | } 402 | else if (ftor == lookup_functor("numbervars",1)) 403 | { 404 | result.numbervars = (memory[VAL(head)+1] == yes) 405 | } 406 | else if (ftor == lookup_functor("variables",1)) 407 | { 408 | result.variables = memory[VAL(head)+1]; 409 | } 410 | else if (ftor == lookup_functor("variable_names",1)) 411 | { 412 | result.variable_names = memory[VAL(head)+1]; 413 | } 414 | else if (ftor == lookup_functor("singletons",1)) 415 | { 416 | result.singletons = memory[VAL(head)+1]; 417 | } 418 | else 419 | { 420 | return type_error(option, head); 421 | } 422 | options = memory[VAL(options)+1]; 423 | } 424 | return result; 425 | } 426 | 427 | function read_term(stream, term, options) 428 | { 429 | if (!(options = parse_term_options(options))) 430 | return false; 431 | var streamindex = VAL(get_arg(stream, 1)); 432 | var s = streams[streamindex]; 433 | var context = {stream:s, peeked_token: undefined}; 434 | var expression = {}; 435 | if (!read_expression(context, Infinity, false, false, expression)) 436 | return false; 437 | expression = expression.value; 438 | // Depending on the situation, we may expect a . now on the stream. 439 | // There will not be one if we are going to return end_of_file because it is actually the eof 440 | // (Of course, if the file contains end_of_file. then we will return end_of_file AND read the . 441 | // Luckily we can distinguish the two cases 442 | // There will also not be one if we are in atom_to_term mode, which is not yet implemented 443 | if (expression.end_of_file === undefined) 444 | { 445 | var period = {}; 446 | if (!read_token(context, period)) 447 | return false; 448 | if (period.value != ".") // Missing period === eof 449 | return syntax_error("end_of_file"); 450 | } 451 | else 452 | expression = "end_of_file"; 453 | debug_msg("Read expression: " + expression_to_string(expression)); 454 | 455 | var varmap = {}; 456 | var singletons = {}; 457 | t1 = expression_to_term(expression, varmap, singletons); 458 | var rc = 1; 459 | if (options.variables !== undefined || options.singletons !== undefined) 460 | { 461 | var equals2 = lookup_functor("=", 2); 462 | var keys = Object.keys(varmap); 463 | for (var i = 0; i < keys.length; i++) 464 | { 465 | var varname = keys[i]; 466 | if (options.variables !== undefined) 467 | { 468 | if (!unify(state.H ^ (TAG_LST << WORD_BITS), options.variables)) 469 | return false; 470 | memory[state.H] = varmap[varname]; 471 | memory[state.H+1] = (state.H+1) ^ (TAG_REF << WORD_BITS); 472 | options.variables = memory[state.H+1]; 473 | state.H+=2; 474 | } 475 | if (options.variable_names !== undefined) 476 | { 477 | if (!unify(state.H ^ (TAG_LST << WORD_BITS), options.variable_names)) 478 | { 479 | debug("not unifiable: " + term_to_string(options.variable_names)); 480 | return false; 481 | } 482 | memory[state.H] = (state.H+2) ^ (TAG_STR << WORD_BITS); 483 | memory[state.H+1] = (state.H+1) ^ (TAG_REF << WORD_BITS); 484 | options.variable_names = memory[state.H+1]; 485 | memory[state.H+2] = equals2; 486 | memory[state.H+3] = lookup_atom(varname); 487 | memory[state.H+4] = varmap[varname]; 488 | state.H+=5; 489 | } 490 | } 491 | if (options.variables !== undefined) 492 | if (!unify(options.variables, NIL)) 493 | return false; 494 | if (options.variable_names !== undefined) 495 | if (!unify(options.variable_names, NIL)) 496 | return false; 497 | } 498 | if (options.singletons !== undefined) 499 | { 500 | var keys = Object.keys(singletons); 501 | for (var i = 0; i < keys.length; i++) 502 | { 503 | var varname = keys[i]; 504 | if (singletons[varname] == 1) 505 | { 506 | if (!unify(state.H ^ (TAG_LST << WORD_BITS), options.singletons)) 507 | return false; 508 | memory[state.H] = (state.H+2) ^ (TAG_STR << WORD_BITS); 509 | memory[state.H+1] = (state.H+1) ^ (TAG_REF << WORD_BITS); 510 | options.singletons = memory[state.H+1]; 511 | memory[state.H+2] = equals2; 512 | memory[state.H+3] = lookup_atom(varname); 513 | memory[state.H+4] = varmap[varname]; 514 | state.H+=5; 515 | } 516 | } 517 | if (!unify(options.singletons, NIL)) 518 | return false; 519 | } 520 | debug_msg("A term has been created ( " + VAL(t1) + " ). Reading it back from the heap gives: " + term_to_string(t1)); 521 | return unify(term, t1); 522 | } 523 | 524 | function predicate_write_term(stream, term, options) 525 | { 526 | if (!(options = parse_term_options(options))) 527 | return false; 528 | var value = format_term(term, options); 529 | var s = {}; 530 | if (!get_stream(stream, s)) 531 | return false; 532 | s = s.value; 533 | if (s.write == null) 534 | return permission_error("output", "stream", stream); 535 | 536 | var bytes = toByteArray(value); 537 | return (s.write(s, 1, bytes.length, bytes) >= 0) 538 | } 539 | 540 | function escape_atom(a) 541 | { 542 | chars = a.split(''); 543 | var result = ""; 544 | for (var i = 0; i < chars.length; i++) 545 | { 546 | if (chars[i] == "'") 547 | result += "\\'"; 548 | else 549 | result += chars[i]; 550 | } 551 | return result; 552 | } 553 | 554 | function quote_atom(a) 555 | { 556 | if (a.charAt(0) >= "A" && a.charAt(0) <= "Z") 557 | return "'" + escape_atom(a) + "'"; 558 | chars = a.split(''); 559 | if (is_punctuation(chars[0])) 560 | { 561 | for (var i = 0; i < chars.length; i++) 562 | { 563 | if (!is_punctuation(chars[i])) 564 | return "'" + escape_atom(a) + "'"; 565 | } 566 | } 567 | else 568 | { 569 | for (var i = 0; i < chars.length; i++) 570 | { 571 | if (is_punctuation(chars[i]) || chars[i] == ' ') 572 | return "'" + escape_atom(a) + "'"; 573 | } 574 | } 575 | return a; 576 | } 577 | 578 | function is_operator(ftor) 579 | { 580 | ftor = VAL(ftor); 581 | if (ftable[ftor][1] == 2 && infix_operators[atable[ftable[ftor][0]]] != undefined) 582 | return true; 583 | if (ftable[ftor][1] == 1 && prefix_operators[atable[ftable[ftor][0]]] != undefined) 584 | return true; 585 | return false; 586 | } 587 | 588 | 589 | function format_term(value, options) 590 | { 591 | if (value == undefined) 592 | abort("Illegal memory access in format_term: " + hex(value) + ". Dumping..."); 593 | value = deref(value); 594 | switch(TAG(value)) 595 | { 596 | case TAG_REF: 597 | if (VAL(value) > HEAP_SIZE) 598 | { 599 | if (state.E > state.B) 600 | lTop = state.E + state.CP.code[state.CP.offset - 1] + 2; 601 | else 602 | lTop = state.B + memory[state.B] + 8; 603 | return "_L" + (lTop - VAL(value)); 604 | } 605 | else 606 | return "_G" + VAL(value); 607 | case TAG_ATM: 608 | atom = atable[VAL(value)]; 609 | if (atom == undefined) 610 | abort("No such atom: " + VAL(value)); 611 | if (options.quoted === true) 612 | return quote_atom(atom); 613 | return atom; 614 | case TAG_INT: 615 | if ((VAL(value) & (1 << (WORD_BITS-1))) == (1 << (WORD_BITS-1))) 616 | return (VAL(value) - (1 << WORD_BITS)) + ""; 617 | else 618 | return VAL(value) + ""; 619 | // fall-through 620 | case TAG_FLT: 621 | return floats[VAL(value)] + ""; 622 | case TAG_STR: 623 | var ftor = VAL(memory[VAL(value)]); 624 | if (options.numbervars === true && ftor == lookup_functor('$VAR', 1) && TAG(memory[VAL(value)+1]) == TAG_INT) 625 | { 626 | var index = VAL(memory[VAL(value)+1]); 627 | var result = String.fromCharCode(65 + (index % 26)); 628 | if (index >= 26) 629 | result = result + Math.floor(index / 26); 630 | return result; 631 | } 632 | if (!is_operator(ftor) || options.ignore_ops === true) 633 | { 634 | // Print in canonical form functor(arg1, arg2, ...) 635 | var result = format_term(ftable[ftor][0] ^ (TAG_ATM << WORD_BITS), options) + "("; 636 | for (var i = 0; i < ftable[ftor][1]; i++) 637 | { 638 | result += format_term(memory[VAL(value)+1+i], options); 639 | if (i+1 < ftable[ftor][1]) 640 | result += ","; 641 | } 642 | return result + ")"; 643 | } 644 | else 645 | { 646 | // Print as an operator 647 | var fname = atable[ftable[ftor][0]]; 648 | if (ftable[ftor][1] == 2 && infix_operators[fname] != undefined) 649 | { 650 | // Infix operator 651 | var lhs = format_term(memory[VAL(value)+1], options); 652 | if (is_punctuation(lhs.charAt(lhs.length-1)) && !is_punctuation(fname.charAt(0))) 653 | result = lhs + fname; 654 | else if (!is_punctuation(lhs.charAt(lhs.length-1)) && is_punctuation(fname.charAt(0))) 655 | result = lhs + fname; 656 | else 657 | { 658 | result = lhs + " " + fname; 659 | } 660 | var rhs = format_term(memory[VAL(value)+2], options); 661 | if (is_punctuation(rhs.charAt(0)) && !is_punctuation(fname.charAt(fname.length-1))) 662 | return result + rhs; 663 | else if (!is_punctuation(rhs.charAt(0)) && is_punctuation(fname.charAt(fname.length-1))) 664 | return result + rhs; 665 | else 666 | return result + " " + rhs; 667 | } 668 | else if (ftable[ftor][1] == 1 && prefix_operators[fname] != undefined) 669 | { 670 | // Prefix operator 671 | var rhs = format_term(memory[VAL(value)+1], options); 672 | if (is_punctuation(rhs.charAt(0)) && !is_punctuation(fname.charAt(fname.length-1))) 673 | return fname + rhs; 674 | else if (!is_punctuation(rhs.charAt(0)) && is_punctuation(fname.charAt(fname.length-1))) 675 | return fname + rhs; 676 | else 677 | return fname + " " + rhs; 678 | 679 | } 680 | } 681 | case TAG_LST: 682 | if (options.ignore_ops) 683 | return "'.'(" + format_term(memory[VAL(value)], options) + "," + format_term(memory[VAL(value)+1], options) + ")"; 684 | // Otherwise we need to print the list in list-form 685 | var result = "["; 686 | var head = memory[VAL(value)]; 687 | var tail = memory[VAL(value)+1]; 688 | while (true) 689 | { 690 | result += format_term(head, options); 691 | if (tail == NIL) 692 | return result + "]"; 693 | else if (TAG(tail) == TAG_LST) 694 | { 695 | head = memory[VAL(tail)]; 696 | tail = memory[VAL(tail)+1]; 697 | result += ","; 698 | } 699 | else 700 | return result + "|" + format_term(tail, options) + "]"; 701 | } 702 | } 703 | } 704 | 705 | 706 | function expression_to_term(s, varmap, singletons) 707 | { 708 | if (typeof(s) == "string") 709 | return lookup_atom(s); 710 | else if (typeof(s) == "number") 711 | { 712 | if (s == ~~s) 713 | { 714 | return (s & ((1 << WORD_BITS)-1)) ^ (TAG_INT << WORD_BITS); 715 | } 716 | else 717 | { 718 | return lookup_float(s); 719 | } 720 | } 721 | else if (s.variable_name !== undefined) 722 | { 723 | if (varmap[s.variable_name] !== undefined) 724 | { 725 | result = state.H; 726 | memory[state.H] = varmap[s.variable_name]; 727 | state.H++; 728 | } 729 | else 730 | { 731 | result = alloc_var(); 732 | varmap[s.variable_name] = result; 733 | } 734 | if (singletons[s.variable_name] === undefined) 735 | singletons[s.variable_name] = 1; 736 | else 737 | singletons[s.variable_name]++; 738 | return result; 739 | } 740 | else if (s.list !== undefined) 741 | { 742 | // Special case for [], as usual, since we do not actually allocate any lists! 743 | if (s.list.length == 0) 744 | return NIL; 745 | 746 | var result = alloc_var(); 747 | var tail = result; 748 | var head; 749 | for (var i = 0; i < s.list.length; i++) 750 | { 751 | unify(tail, state.H ^ (TAG_LST << WORD_BITS)); 752 | head = alloc_var(); 753 | tail = alloc_var(); 754 | unify(head, expression_to_term(s.list[i], varmap, singletons)); 755 | } 756 | unify(tail, expression_to_term(s.tail, varmap, singletons)); 757 | return result; 758 | } 759 | else if (s.functor !== undefined) 760 | { 761 | var t = (state.H ^ TAG_STR << WORD_BITS); 762 | memory[state.H++] = lookup_functor(s.functor, s.args.length); 763 | // Reserve space for the args 764 | var var_args = []; 765 | for (var i = 0; i < s.args.length; i++) 766 | var_args[i] = alloc_var(); 767 | for (var i = 0; i < s.args.length; i++) 768 | { 769 | z = expression_to_term(s.args[i], varmap, singletons); 770 | unify(z, var_args[i]); 771 | } 772 | return t; 773 | } 774 | else 775 | abort("Invalid expression: " + JSON.stringify(s)); 776 | } 777 | 778 | function peek_token(s, t) 779 | { 780 | if (s.peek_tokens === undefined || s.peeked_tokens.length == 0 ) 781 | { 782 | var tt = {}; 783 | if (!read_token(s, tt)) 784 | return false; 785 | s.peeked_tokens = [tt.value]; 786 | } 787 | t.value = s.peeked_tokens[0]; 788 | return true; 789 | } 790 | 791 | function unread_token(s, t) 792 | { 793 | if (s.peeked_tokens === undefined) 794 | s.peeked_tokens = [t]; 795 | else 796 | s.peeked_tokens.push(t); 797 | } 798 | 799 | function read_token(s, t) 800 | { 801 | if (s.peeked_tokens !== undefined && s.peeked_tokens.length != 0) 802 | { 803 | t.value = s.peeked_tokens.pop(); 804 | return true; 805 | } 806 | if (!lex(s.stream, t)) 807 | return false; 808 | return true; 809 | } 810 | 811 | function is_char(c) 812 | { 813 | return ((c >= 'a' && c <= 'z') || 814 | (c >= 'A' && c <= 'Z') || 815 | (c >= '0' && c <= '9') || 816 | c == '_'); 817 | } 818 | 819 | var punctuation_array = ['`', '~', '@', '#', '$', '^', '&', '*', '-', '+', '=', '<', '>', '/', '?', ':', ',', '\\', '.']; 820 | 821 | function is_punctuation(c) 822 | { 823 | return punctuation_array.indexOf(c) != -1; 824 | } 825 | 826 | // lex(stream, t) returns a single token in t.value and fails if an exception is raised 827 | function lex(s, t) 828 | { 829 | var token; 830 | while(true) 831 | { 832 | var c = get_raw_char_with_conversion(s); 833 | if (c == -1) 834 | { 835 | t.value = null; 836 | return true; 837 | } 838 | // Consume any whitespace 839 | if (c == ' ' || c == '\n' || c == '\t') 840 | continue; 841 | else if (c == '%') 842 | { 843 | do 844 | { 845 | d = get_raw_char_with_conversion(s); 846 | if (d == -1) 847 | { 848 | t.value = null; 849 | return true; 850 | } 851 | } while(d != '\n'); 852 | continue; 853 | } 854 | else if (c == '/') 855 | { 856 | d = peek_raw_char_with_conversion(s); 857 | if (d == '*') 858 | { 859 | // Block comment 860 | get_raw_char_with_conversion(s); 861 | while(true) 862 | { 863 | d = get_raw_char_with_conversion(s); 864 | if (d == -1) 865 | return syntax_error("end of file in block comment"); 866 | if (d == '*' && get_raw_char_with_conversion(s) == '/') 867 | break; 868 | } 869 | continue; 870 | } 871 | else 872 | { 873 | // My mistake, the term actually begins with /. c is still set to the right thing 874 | break; 875 | } 876 | } 877 | break; 878 | } 879 | if ((c >= 'A' && c <= 'Z') || c == '_') 880 | { 881 | token = {variable_name: "" + c}; 882 | // Variable. May contain a-zA-Z0-9_ 883 | while (true) 884 | { 885 | c = peek_raw_char_with_conversion(s); 886 | if (is_char(c)) 887 | { 888 | token.variable_name += get_raw_char_with_conversion(s); 889 | } 890 | else 891 | { 892 | t.value = token; 893 | return true; 894 | } 895 | } 896 | } 897 | else if ((c >= '0' && c <= '9') || (c == '-' && peek_raw_char_with_conversion(s) >= '0' && peek_raw_char_with_conversion(s) <= '9')) 898 | { 899 | // Integer. May contain 0-9 only. Floats complicate this a bit 900 | var negate = false; 901 | if (c == '-') 902 | { 903 | token = ''; 904 | negate = true; 905 | } 906 | else 907 | token = c - '0'; 908 | var decimal_places = 0; 909 | var seen_decimal = false; 910 | while (true) 911 | { 912 | c = peek_raw_char_with_conversion(s); 913 | if (seen_decimal) 914 | decimal_places++; 915 | if ((c >= '0' && c <= '9')) 916 | { 917 | token = token * 10 + (get_raw_char_with_conversion(s) - '0'); 918 | } 919 | else if (c == '.' && !seen_decimal) 920 | { 921 | // Fixme: Also must check that the next char is actually a number. Otherwise 'X = 3.' will confuse things somewhat. 922 | seen_decimal = true; 923 | get_raw_char_with_conversion(s); 924 | continue; 925 | } 926 | else if (is_char(c)) 927 | return syntax_error("illegal number" + token + ": " + c); 928 | else 929 | { 930 | if (seen_decimal) 931 | { 932 | for (var i = 1; i < decimal_places; i++) 933 | token = token / 10; 934 | } 935 | t.value = negate?(-token):token; 936 | return true; 937 | } 938 | } 939 | } 940 | else 941 | { 942 | // Either: 943 | // 1) a term 944 | // 2) an atom (which is a term with no arguments) 945 | // 3) An operator 946 | // In all cases, first we have to read an atom 947 | var buffer = ""; 948 | var state = 0; 949 | if (c == '\'') 950 | { 951 | // Easy. The atom is quoted! 952 | while(true) 953 | { 954 | c = get_raw_char_with_conversion(s); 955 | if (c == '\\') 956 | state = (state + 1) % 2; 957 | if (c == -1) 958 | return syntax_error("end of file in atom"); 959 | if (c == '\'' && state == 0) 960 | break; 961 | buffer += c; 962 | } 963 | 964 | } 965 | else // Not so simple. Have to read an atom using rules, which are actually available only for a fee from ISO... 966 | { 967 | buffer += c; 968 | // An unquoted atom may contain either all punctuation or all A-Za-z0-9_. There are probably more complicated rules, but this will do 969 | char_atom = is_char(c); 970 | punctuation_atom = is_punctuation(c); 971 | while (true) 972 | { 973 | c = peek_raw_char_with_conversion(s); 974 | if (c == -1) 975 | break; 976 | if (char_atom && is_char(c)) 977 | buffer += get_raw_char_with_conversion(s); 978 | else if (punctuation_atom && is_punctuation(c)) 979 | buffer += get_raw_char_with_conversion(s); 980 | else 981 | break; 982 | } 983 | } 984 | t.value=buffer; 985 | return true; 986 | } 987 | } 988 | 989 | // This is one of the more ridiculous things in the ISO standard 990 | var char_conversion_override = {}; 991 | function predicate_char_conversion(a, b) 992 | { 993 | if (TAG(a) != TAG_ATM) 994 | return type_error("atom", a); 995 | if (TAG(b) != TAG_ATM) 996 | return type_error("atom", b); 997 | char_conversion_override[atable[VAL(a)]] = atable[VAL(b)]; 998 | return true; 999 | } 1000 | 1001 | function predicate_current_char_conversion(a, b) 1002 | { 1003 | if (TAG(a) == TAG_ATM) 1004 | { 1005 | var aname = atable[VAL(a)]; 1006 | if (char_conversion_override[aname] === undefined) 1007 | return unify(a, b); 1008 | else 1009 | return unify(lookup_atom(char_conversion_override[aname]), b); 1010 | } 1011 | else if (TAG(b) == TAG_ATM) 1012 | { 1013 | var bname = btable[VAL(b)]; 1014 | var keys = Object.keys(char_conversion_override); 1015 | for (var i = 0; i < keys.length; i++) 1016 | { 1017 | if (char_conversion_override[keys[i]] == bname) 1018 | return unify(lookup_atom(keys[i]), a); 1019 | } 1020 | return unify(a,b); 1021 | } 1022 | if (TAG(a) == TAG_REF && TAG(b) == TAG_REF) 1023 | { 1024 | if (state.foreign_retry) 1025 | { 1026 | index = state.foreign_value + 1; 1027 | } 1028 | else 1029 | { 1030 | create_choicepoint(); 1031 | index = 0; 1032 | } 1033 | update_choicepoint_data(index); 1034 | aname = String.fromCharCode(index); 1035 | unify(a, lookup_atom(aname)); 1036 | if (char_conversion_override[aname] === undefined) 1037 | return unify(a, b); 1038 | else 1039 | return unify(lookup_atom(char_conversion_override[aname]), b); 1040 | 1041 | } 1042 | else 1043 | return type_error(a); 1044 | } 1045 | 1046 | function get_raw_char_with_conversion(s) 1047 | { 1048 | if (!prolog_flag_values['char_conversion']) 1049 | return get_raw_char(s); 1050 | var t = get_raw_char(s); 1051 | var tt = char_conversion_override[t]; 1052 | if (tt === undefined) 1053 | return t; 1054 | else 1055 | return tt; 1056 | } 1057 | 1058 | function peek_raw_char_with_conversion(s) 1059 | { 1060 | if (!prolog_flag_values['char_conversion']) 1061 | return peek_raw_char(s); 1062 | var t = peek_raw_char(s); 1063 | var tt = char_conversion_override[t]; 1064 | if (tt === undefined) 1065 | return t; 1066 | else 1067 | return tt; 1068 | } 1069 | 1070 | 1071 | function parser_test() 1072 | { 1073 | //do_parser_test("test(1,1).\ntest(1:-1).\ntest:- test, test.\ntest((1,1))."); 1074 | //do_parser_test("foo:- a, b, c."); 1075 | do_parser_test("foo([a|b])."); 1076 | } 1077 | 1078 | function parser_test_read(stream, size, count, buffer) 1079 | { 1080 | var bytes_read = 0; 1081 | var records_read; 1082 | for (records_read = 0; records_read < count; records_read++) 1083 | { 1084 | for (var b = 0; b < size; b++) 1085 | { 1086 | t = stream.data.shift(); 1087 | if (t === undefined) 1088 | { 1089 | return records_read; 1090 | } 1091 | buffer[bytes_read++] = t; 1092 | } 1093 | } 1094 | return records_read; 1095 | } 1096 | 1097 | function do_parser_test(input_string) 1098 | { 1099 | s = {peeked_token: undefined, 1100 | stream: new_stream(parser_test_read, 1101 | null, 1102 | null, 1103 | null, 1104 | null, 1105 | toByteArray(input_string))}; 1106 | state = {H:0}; 1107 | while(true) 1108 | { 1109 | var e = {}; 1110 | if (!read_expression(s, Infinity, false, false, e)) 1111 | { 1112 | debug("Failed to parse"); 1113 | return false; 1114 | } 1115 | e = e.value; 1116 | if (e.end_of_file == true) 1117 | break; 1118 | debug("Read expression: " + expression_to_string(e)); 1119 | 1120 | var p = {}; 1121 | if (!read_token(s, p)) 1122 | { 1123 | debug("Failed to parse"); 1124 | return false; 1125 | } 1126 | p = p.value; 1127 | if (p == ".") 1128 | { 1129 | debug_msg("Expression terminated with fullstop") 1130 | } 1131 | else 1132 | { 1133 | debug("Error: Expression terminated with >" + p + "<"); 1134 | } 1135 | debug_msg(expression_to_string(e)); 1136 | if (e.end_of_file !== undefined) 1137 | break; 1138 | } 1139 | } 1140 | 1141 | function expression_to_string(s) 1142 | { 1143 | if (typeof(s) == "string") 1144 | return s; 1145 | if (typeof(s) == "number") 1146 | return s; 1147 | if (s.variable_name !== undefined) 1148 | return "_" + s.variable_name; 1149 | if (s.list !== undefined) 1150 | { 1151 | t = "["; 1152 | for (var i = 0; i < s.list.length; i++) 1153 | { 1154 | if (i+1 < s.list.length) 1155 | t += expression_to_string(s.list[i]) + ", "; 1156 | else 1157 | { 1158 | t += expression_to_string(s.list[i]) 1159 | if (s.tail == "[]") 1160 | t += "]"; 1161 | else 1162 | t += "|" + expression_to_string(s.tail) + "]"; 1163 | } 1164 | } 1165 | return t; 1166 | } 1167 | if (s.functor !== undefined) 1168 | { 1169 | t = "" + s.functor + "("; 1170 | for (var i = 0; i < s.args.length; i++) 1171 | { 1172 | if (i+1 < s.args.length) 1173 | { 1174 | t += expression_to_string(s.args[i]) + ", "; 1175 | } 1176 | else 1177 | t += expression_to_string(s.args[i]) + ")"; 1178 | } 1179 | return t; 1180 | } 1181 | } 1182 | 1183 | 1184 | function atom_to_term(atom, term, bindings) 1185 | { 1186 | var stream = new_stream(read_atom, null, null, null, null, {data:toByteArray(atable[VAL(atom)]), ptr:0}); 1187 | var context = {stream:stream, peeked_token: undefined}; 1188 | var expression = {}; 1189 | if (!read_expression(context, Infinity, false, false, expression)) 1190 | return false; 1191 | expression = expression.value; 1192 | b = {}; 1193 | t1 = expression_to_term(expression, b, {}); 1194 | arglist = []; 1195 | keys = Object.keys(b); 1196 | for (var i = 0 ; i < keys.length; i++) 1197 | arglist.push({functor:"=", args:[keys[i], {variable_name:keys[i]}]}); 1198 | t2 = expression_to_term({list:arglist, tail:{list: []}}, b, {}); 1199 | debug_msg("Expression: " + expression_to_string({list:arglist, tail:[]})); 1200 | debug_msg("Bindings have been created ( " + VAL(t2) + " ). Reading it back from the heap gives: " + term_to_string(t2)); 1201 | return unify(term, t1) && unify(bindings, t2); 1202 | } 1203 | 1204 | function read_atom(stream, size, count, buffer) 1205 | { 1206 | var bytes_read = 0; 1207 | var records_read; 1208 | var info = stream.data; 1209 | for (records_read = 0; records_read < count; records_read++) 1210 | { 1211 | for (var b = 0; b < size; b++) 1212 | { 1213 | t = info.data[info.ptr++]; 1214 | if (t === undefined) 1215 | return records_read; 1216 | buffer[bytes_read++] = t; 1217 | } 1218 | } 1219 | return records_read; 1220 | } 1221 | 1222 | -------------------------------------------------------------------------------- /record.js: -------------------------------------------------------------------------------- 1 | /* Need to implement recorda/3, recorded/3 and erase/1 */ 2 | var database_ptr = 0; 3 | var database_references = {}; 4 | var databases = {}; 5 | 6 | /* 7 | Because we don't have access to pointers in Javascript, this is quite hard to do efficiently. It's quite hard to do at all! 8 | database_references contains a key-value pair with uniquely generated integer keys. The key is returned as a clause reference. 9 | The database_reference:value is an object containing two values: Array and Index. 10 | Array is a key into the databases object. The database:value is an array. Index is the index into that array of the actual value 11 | stored in the clause reference. 12 | Eventually I will move the code into databases[0] 13 | */ 14 | 15 | function recorda(key, term, ref) 16 | { 17 | // Get the database associated with key. 18 | var d = databases[key]; 19 | var i = 0; 20 | debug_msg("recording..."); 21 | if (d === undefined) 22 | { 23 | debug_msg("Creating new database..."); 24 | // No such database yet. Create one, and store it in databases 25 | databases[key] = {data:{}, 26 | keys:new Array(), 27 | ptr: 0}; 28 | d = databases[key]; 29 | debug_msg("Created databases[" + key + "] as " + JSON.stringify(databases[key])); 30 | } 31 | else 32 | { 33 | i = d.ptr; 34 | } 35 | debug_msg("Storing value with key " + i + " and reference " + database_ptr); 36 | // Now store the term in d at i 37 | d.data[i] = {value: record_term(term), 38 | ref: database_ptr}; 39 | // And finally, store the key in the keys arrays, putting it at the front 40 | d.keys.unshift(i); 41 | 42 | debug_msg("stored " + JSON.stringify(d)); 43 | 44 | d.ptr++; 45 | // Next, save the clause reference in database_references 46 | database_references[database_ptr] = {array: key, 47 | index: i}; 48 | debug_msg("database_references[" + database_ptr + "] = " + JSON.stringify(database_references[database_ptr])); 49 | // And now we can unify it with ref 50 | var result = unify(ref, database_ptr ^ (TAG_INT << WORD_BITS)); 51 | // And increment it 52 | database_ptr++; 53 | return result; 54 | } 55 | 56 | 57 | function recordz(key, term, ref) 58 | { 59 | // Get the database associated with key. 60 | var d = databases[key]; 61 | var i = 1; 62 | debug_msg("recording..."); 63 | if (d === undefined) 64 | { 65 | debug_msg("Creating new database..."); 66 | // No such database yet. Create one, and store it in databases 67 | databases[key] = {data:{}, 68 | keys:new Array(), 69 | ptr: 0}; 70 | d = databases[key]; 71 | debug_msg("Created databases[" + key + "] as " + JSON.stringify(databases[key])); 72 | } 73 | else 74 | { 75 | i = d.ptr; 76 | } 77 | debug_msg("Storing value with key " + i + " and reference " + database_ptr); 78 | // Now store the term in d at i 79 | d.data[i] = {value: record_term(term), 80 | ref: database_ptr}; 81 | // And finally, store the key in the keys arrays, putting it at the front 82 | d.keys.push(i); 83 | 84 | debug_msg("stored " + JSON.stringify(d)); 85 | 86 | databases[key].ptr++; 87 | // Next, save the clause reference in database_references 88 | database_references[database_ptr] = {array: key, 89 | index: i}; 90 | // And now we can unify it with ref 91 | var result = unify(ref, database_ptr ^ (TAG_INT << WORD_BITS)); 92 | // And increment it 93 | database_ptr++; 94 | return result; 95 | } 96 | 97 | function recorded(key, term, ref) 98 | { 99 | debug_msg("Retrieving"); 100 | // Ok, first find the database 101 | var d = databases[key]; 102 | // Check if there is anything recorded. If not, fail. 103 | if (d === undefined) 104 | { 105 | debug_msg("No terms"); 106 | return false; 107 | } 108 | // Ok, now we can get the actual array 109 | var data = d.data; 110 | // We need the first actual key. This may not be [0] if something has been erased 111 | debug_msg("Keys: " + JSON.stringify(Object.keys(data))); 112 | var index = d.keys[0]; 113 | debug_msg("Returning reference " + d.data[index].ref); 114 | var result = unify(recall_term(d.data[index].value, {}), term) && unify(d.data[index].ref ^ (TAG_INT << WORD_BITS), ref); 115 | debug_msg("Result: " + result + " => " + term_to_string(term) + " ====> " + term_to_string(ref)); 116 | return result; 117 | } 118 | 119 | function erase(ref) 120 | { 121 | // First find the array 122 | debug_msg("Erasing reference " + VAL(ref)); 123 | var dr = database_references[VAL(ref)]; 124 | if (dr === undefined) 125 | return false; 126 | debug_msg("Got reference " + JSON.stringify(dr)); 127 | var d = databases[dr.array]; 128 | debug_msg("Got database " + d); 129 | // Now set to undefined 130 | delete d.data[dr.index]; 131 | // Now we must also delete the keys entry. This requires a search, unfortunately since there is no way to keep track of indices if we allow unshifting 132 | debug_msg("Deleting key " + dr.index); 133 | for (i = 0; i < d.keys.length; i++) 134 | { 135 | if (d.keys[i] == dr.index) 136 | { 137 | d.keys.splice(i, 1); 138 | break; 139 | } 140 | } 141 | 142 | debug_msg("Success"); 143 | return true; 144 | } 145 | 146 | // record_term returns a new object which is a javascript representation of the term 147 | function record_term(t) 148 | { 149 | t = deref(t); 150 | switch(TAG(t)) 151 | { 152 | case TAG_REF: 153 | return {type: TAG_REF, 154 | key: VAL(t)}; 155 | case TAG_ATM: 156 | return {type: TAG_ATM, 157 | value: atable[VAL(t)]}; 158 | case TAG_FLT: 159 | return {type: TAG_FLT, 160 | value: floats[VAL(t)]}; 161 | case TAG_INT: 162 | return {type: TAG_INT, 163 | value: VAL(t)}; 164 | case TAG_LST: 165 | var value = []; 166 | var list = {type: TAG_LST, 167 | value: value}; 168 | while (TAG(t) == TAG_LST) 169 | { 170 | value.push(record_term(VAL(t))); 171 | t = memory[VAL(t)+1]; 172 | } 173 | list.tail = record_term(t); 174 | return list; 175 | case TAG_STR: 176 | var ftor = ftable[VAL(memory[VAL(t)])]; 177 | var args = []; 178 | var result = {type: TAG_STR, 179 | name: atable[ftor[0]], 180 | args: args}; 181 | for (var i = 0; i < ftor[1]; i++) 182 | { 183 | args.push(record_term(memory[VAL(t)+1+i])); 184 | } 185 | return result; 186 | } 187 | } 188 | 189 | function recall_term(e, varmap) 190 | { 191 | // return a reference to an equivalent WAM term to the expression e 192 | switch(e.type) 193 | { 194 | case TAG_REF: 195 | var result; 196 | if (varmap[e.key] !== undefined) 197 | { 198 | result = state.H; 199 | memory[state.H] = varmap[e.key]; 200 | state.H++; 201 | } 202 | else 203 | { 204 | result = alloc_var(); 205 | varmap[e.key] = result; 206 | } 207 | return result; 208 | case TAG_ATM: 209 | return lookup_atom(e.value); 210 | case TAG_FLT: 211 | return lookup_float(e.value); 212 | case TAG_INT: 213 | return e.value ^ (TAG_INT << WORD_BITS); 214 | case TAG_LST: 215 | var result = alloc_var(); 216 | var tail = result; 217 | var head; 218 | for (var i = 0; i < e.value.length; i++) 219 | { 220 | unify(tail, state.H ^ (TAG_LST << WORD_BITS)); 221 | head = alloc_var(); 222 | tail = alloc_var(); 223 | unify(head, recall_term(e.value[i], varmap)); 224 | } 225 | unify(tail, recall_term(e.tail, varmap)); 226 | return result; 227 | case TAG_STR: 228 | var t = (state.H ^ TAG_STR << WORD_BITS); 229 | memory[state.H++] = lookup_functor(e.name, e.args.length); 230 | // Reserve space for the args 231 | var var_args = []; 232 | for (var i = 0; i < e.args.length; i++) 233 | var_args[i] = alloc_var(); 234 | for (var i = 0; i < e.args.length; i++) 235 | { 236 | z = recall_term(e.args[i], varmap); 237 | unify(z, var_args[i]); 238 | } 239 | return t; 240 | default: 241 | abort("invalid term type: " + JSON.stringify(e)); 242 | } 243 | } 244 | -------------------------------------------------------------------------------- /standalone.js: -------------------------------------------------------------------------------- 1 | var stdout_buffer = ""; 2 | 3 | function stdout(msg) 4 | { 5 | var lines = (stdout_buffer + msg).split('\n'); 6 | for (var i = 0; i < lines.length-1; i++) 7 | { 8 | debug(lines[i]); 9 | } 10 | stdout_buffer = lines[lines.length-1]; 11 | } 12 | 13 | function predicate_flush_stdout() 14 | { 15 | if (stdout_buffer != "") 16 | stdout("\n"); 17 | return true; 18 | } 19 | -------------------------------------------------------------------------------- /stream.js: -------------------------------------------------------------------------------- 1 | var current_input = null; 2 | var current_output = 0; 3 | // FIXME: Ignores size and count! 4 | function stdout_write(stream, size, count, buffer) 5 | { 6 | var str = fromByteArray(buffer); 7 | stdout(str); 8 | return size*count; 9 | } 10 | 11 | function predicate_set_input(stream) 12 | { 13 | var s = {}; 14 | if (!get_stream_fd(stream, s)) 15 | return false; 16 | current_input = s.value; 17 | return true; 18 | } 19 | 20 | function predicate_set_output(stream) 21 | { 22 | var s = {}; 23 | if (!get_stream_fd(stream, s)) 24 | return false; 25 | current_output = s.value; 26 | return true; 27 | } 28 | 29 | function predicate_current_input(stream) 30 | { var ftor = lookup_functor('$stream', 1); 31 | var ref = alloc_structure(ftor); 32 | memory[state.H++] = current_input ^ (TAG_INT << WORD_BITS); 33 | return unify(stream, ref); 34 | } 35 | 36 | function predicate_current_output(stream) 37 | { var ftor = lookup_functor('$stream', 1); 38 | var ref = alloc_structure(ftor); 39 | memory[state.H++] = current_output ^ (TAG_INT << WORD_BITS); 40 | return unify(stream, ref); 41 | } 42 | 43 | function predicate_get_char(stream, c) 44 | { 45 | var s = {}; 46 | if (!get_stream(stream, s)) 47 | return false; 48 | return unify(c, lookup_atom(_get_char(s.value))); 49 | } 50 | 51 | function predicate_get_code(stream, c) 52 | { 53 | var s = {}; 54 | if (!get_stream(stream, s)) 55 | return false; 56 | return unify(c, (_get_code(s.value) & ((1 << (WORD_BITS-1))-1)) ^ (TAG_INT << WORD_BITS)); 57 | } 58 | 59 | function predicate_get_byte(stream, c) 60 | { 61 | var s = {}; 62 | if (!get_stream(stream, s)) 63 | return false; 64 | return unify(c, (getb(s.value) & ((1 << (WORD_BITS-1))-1)) ^ (TAG_INT << WORD_BITS)); 65 | } 66 | 67 | function predicate_peek_char(stream, c) 68 | { 69 | var s = {}; 70 | if (!get_stream(stream, s)) 71 | return false; 72 | return unify(c, lookup_atom(peek_char(s.value))); 73 | } 74 | 75 | function predicate_peek_code(stream, c) 76 | { 77 | var s = {}; 78 | if (!get_stream(stream, s)) 79 | return false; 80 | return unify(c, _peek_code(s.value) ^ (TAG_INT << WORD_BITS)); 81 | } 82 | 83 | function predicate_peek_byte(stream, c) 84 | { 85 | var s = {}; 86 | if (!get_stream(stream, s)) 87 | return false; 88 | return unify(c, (peekb(s.value) & ((1 << (WORD_BITS-1))-1)) ^ (TAG_INT << WORD_BITS)); 89 | } 90 | 91 | function predicate_put_char(stream, c) 92 | { 93 | var s = {}; 94 | if (!get_stream(stream, s)) 95 | return false; 96 | return putch(s.value, atable[VAL(c)]); 97 | } 98 | 99 | function predicate_put_code(stream, c) 100 | { 101 | var s = {}; 102 | if (!get_stream(stream, s)) 103 | return false; 104 | return putch(s.value, VAL(c)); 105 | } 106 | 107 | function predicate_put_byte(stream, c) 108 | { 109 | var s = {}; 110 | if (!get_stream(stream, s)) 111 | return false; 112 | return putb(s.value, VAL(c)); 113 | } 114 | 115 | function predicate_flush_output(stream) 116 | { 117 | var s = {}; 118 | if (!get_stream(stream, s)) 119 | return false; 120 | if (s.value.write != null) 121 | { 122 | return s.value.buffer_size == s.value.write(s.value, 1, s.value.buffer_size, s.value.buffer); 123 | } 124 | return permission_error("write", "stream", stream); 125 | } 126 | 127 | function predicate_at_end_of_stream(stream) 128 | { 129 | var s = {}; 130 | if (!get_stream(stream, s)) 131 | return false; 132 | return (peekch(s.value) != -1); 133 | } 134 | 135 | function predicate_set_stream_position(s, position) 136 | { 137 | var stream = {}; 138 | if (!get_stream(s, stream)) 139 | return false; 140 | stream = stream.value; 141 | if (stream.seek == null) 142 | return permission_error("seek", "stream", s); 143 | return stream.seek(stream, VAL(position)); 144 | } 145 | 146 | /* Actual stream IO */ 147 | var streams = [new_stream(null, stdout_write, null, null, null, "")]; 148 | function predicate_close(stream, options) 149 | { 150 | var s = {}; 151 | if (!get_stream(stream, s)) 152 | return false; 153 | s = s.value; 154 | if (s.write != null) 155 | { 156 | // Flush output 157 | // FIXME: If flush fails, then what? 158 | s.write(s, 1, s.buffer_size, s.buffer); 159 | } 160 | if (s.close != null) 161 | { 162 | // FIXME: Ignore s.close(s) if options contains force(true) 163 | return s.close(s); 164 | } 165 | // FIXME: Should be an error 166 | return false; 167 | } 168 | 169 | function get_stream(term, ref) 170 | { 171 | var fd = {}; 172 | if (!get_stream_fd(term, fd)) 173 | return false; 174 | ref.value = streams[fd.value]; 175 | return true; 176 | } 177 | 178 | function get_stream_fd(term, s) 179 | { 180 | if (TAG(term) != TAG_STR) 181 | return type_error("stream", term); 182 | ftor = VAL(memory[VAL(term)]); 183 | if (atable[ftable[ftor][0]] == "$stream" && ftable[ftor][1] == 1) 184 | { 185 | s.value = VAL(memory[VAL(term)+1]); 186 | return true; 187 | } 188 | return type_error("stream", term); 189 | } 190 | 191 | // Streams must all have a buffer to support peeking. 192 | // If the buffer is empty, then fill it via read() 193 | var STREAM_BUFFER_SIZE = 256; 194 | 195 | function new_stream(read, write, seek, close, tell, user_data) 196 | { 197 | return {read: read, 198 | write: write, 199 | seek: seek, 200 | close: close, 201 | tell: tell, 202 | data: user_data, 203 | buffer: [], 204 | buffer_size: 0}; 205 | } 206 | 207 | function _get_char(s) 208 | { 209 | var t = getch(s); 210 | if (t == -1) 211 | return "end_of_file"; 212 | else 213 | return String.fromCharCode(t); 214 | } 215 | 216 | function get_raw_char(s) 217 | { 218 | var t = getch(s); 219 | if (t == -1) 220 | return -1; 221 | else 222 | return String.fromCharCode(t); 223 | } 224 | 225 | function peek_raw_char(s) 226 | { 227 | var t = peekch(s); 228 | if (t == -1) 229 | return -1; 230 | else 231 | return String.fromCharCode(t); 232 | } 233 | 234 | 235 | function _peek_char(s) 236 | { 237 | var t = peekch(s); 238 | if (t == -1) 239 | return "end_of_file"; 240 | else 241 | return String.fromCharCode(t); 242 | } 243 | 244 | function _get_code(s) 245 | { 246 | return getch(s); 247 | } 248 | 249 | function _peek_code(s) 250 | { 251 | return peekch(s); 252 | } 253 | // See getch for an explanation of what is going on here 254 | function peekch(s) 255 | { 256 | var b = peekb(s); 257 | var ch; 258 | if (b == -1) 259 | return -1; 260 | // ASCII 261 | if (b <= 0x7F) 262 | return b; 263 | ch = 0; 264 | var mask = 0x20; 265 | var i = 0; 266 | for (var mask = 0x20; mask != 0; mask >>=1 ) 267 | { 268 | var next = s.buffer[i+1]; 269 | if (next == undefined) 270 | { 271 | // This is a problem. We need to buffer more data! But we must also not lose the existing buffer since we are peeking. 272 | abort("Unicode break in peekch. This is a bug"); 273 | } 274 | if (next == -1) 275 | return -1; 276 | ch = (ch << 6) ^ (next & 0x3f); 277 | if ((b & mask) == 0) 278 | break; 279 | i++; 280 | } 281 | ch ^= (b & (0xff >> (i+3))) << (6*(i+1)); 282 | return ch; 283 | } 284 | 285 | function getch(s) 286 | { 287 | var b = getb(s); 288 | var ch; 289 | if (b == -1) 290 | return -1; 291 | // ASCII 292 | if (b <= 0x7F) 293 | return b; 294 | ch = 0; 295 | // Otherwise we have to crunch the numbers 296 | var mask = 0x20; 297 | var i = 0; 298 | // The first byte has leading bits 1, then a 1 for every additional byte we need followed by a 0 299 | // After the 0 is the top 1-5 bits of the final character. This makes it quite confusing. 300 | for (var mask = 0x20; mask != 0; mask >>=1 ) 301 | { 302 | var next = getb(s); 303 | if (next == -1) 304 | return -1; 305 | ch = (ch << 6) ^ (next & 0x3f); 306 | if ((b & mask) == 0) 307 | break; 308 | i++; 309 | } 310 | ch ^= (b & (0xff >> (i+3))) << (6*(i+1)); 311 | return ch; 312 | } 313 | 314 | function putch(s, c) 315 | { 316 | if (s.buffer_size < 0) 317 | return io_error("write"); 318 | s.buffer.push(c); 319 | s.buffer_size++; 320 | return true; 321 | } 322 | 323 | 324 | function putb(s, c) 325 | { 326 | if (s.buffer_size < 0) 327 | return io_error("write"); 328 | s.buffer.push(c); 329 | s.buffer_size++; 330 | return true; 331 | } 332 | 333 | function getb(s) 334 | { 335 | if (s.buffer_size == 0) 336 | { 337 | debug_msg("Buffering..."); 338 | s.buffer_size = s.read(s, 1, STREAM_BUFFER_SIZE, s.buffer); 339 | debug_msg("Buffer now contains " + s.buffer_size + " elements"); 340 | } 341 | if (s.buffer_size < 0) 342 | return s.buffer_size; 343 | // FIXME: Can this STILL be 0? 344 | if (s.buffer_size == 0) 345 | return -1; 346 | // At this point the buffer has some data in it 347 | s.buffer_size--; 348 | return s.buffer.shift(); 349 | } 350 | 351 | function peekb(s) 352 | { 353 | if (s.buffer_size == 0) 354 | { 355 | debug_msg("Buffering..."); 356 | s.buffer_size = s.read(s, 1, STREAM_BUFFER_SIZE, s.buffer); 357 | debug_msg("Buffer now contains " + s.buffer_size + " elements"); 358 | } 359 | if (s.buffer_size < 0) 360 | return s.buffer_size; 361 | // FIXME: Can this STILL be 0? 362 | if (s.buffer_size == 0) 363 | return -1; 364 | // At this point the buffer has some data in it 365 | return s.buffer[0]; 366 | } 367 | 368 | function get_stream_position(stream, property) 369 | { 370 | if (stream.tell != null) 371 | { 372 | var p = stream.tell(stream) - stream.buffer.length; 373 | var ftor = lookup_functor('position', 1); 374 | var ref = alloc_structure(ftor); 375 | memory[state.H++] = p ^ (TAG_INT << WORD_BITS); 376 | return unify(ref, property); 377 | } 378 | return false; 379 | } 380 | 381 | var stream_properties = [get_stream_position]; 382 | 383 | function predicate_stream_property(stream, property) 384 | { 385 | var s = {}; 386 | if (!get_stream(stream, s)) 387 | return false; 388 | stream = s.value; 389 | var index = 0; 390 | if (state.foreign_retry) 391 | { 392 | index = state.foreign_value+1; 393 | } 394 | else 395 | { 396 | create_choicepoint(); 397 | } 398 | update_choicepoint_data(index); 399 | 400 | if (index >= stream_properties.length) 401 | { 402 | destroy_choicepoint(); 403 | return false; 404 | } 405 | return stream_properties[index](stream, property) 406 | } 407 | 408 | function predicate_current_stream(stream) 409 | { 410 | var index = 0; 411 | if (state.foreign_retry) 412 | { 413 | index = state.foreign_value+1; 414 | } 415 | else 416 | { 417 | create_choicepoint(); 418 | } 419 | while (streams[index] === undefined) 420 | { 421 | if (index >= streams.length) 422 | { 423 | destroy_choicepoint(); 424 | return false; 425 | } 426 | index++; 427 | } 428 | update_choicepoint_data(index); 429 | var ftor = lookup_functor('$stream', 1); 430 | var ref = alloc_structure(ftor); 431 | memory[state.H++] = index ^ (TAG_INT << WORD_BITS); 432 | return unify(stream, ref); 433 | } 434 | -------------------------------------------------------------------------------- /test.css: -------------------------------------------------------------------------------- 1 | .old_query 2 | { 3 | color: #aaa; 4 | } 5 | 6 | .query 7 | { 8 | color: #00f; 9 | } -------------------------------------------------------------------------------- /test.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | WAM Test 4 | 5 | 6 | 7 | 8 | 9 | 10 |
11 | 19 | 20 |
21 |
22 | 23 | 24 | 25 | 31 | 32 | -------------------------------------------------------------------------------- /test.js: -------------------------------------------------------------------------------- 1 | var x_history = []; 2 | var h_ptr = -1; 3 | 4 | var query = ""; 5 | debugging = false; 6 | var output_console = null; 7 | load_state(); 8 | initialize(); 9 | var can_backtrack = false; 10 | 11 | function preventBackspace(e) 12 | { 13 | if (e.keyCode == 8 && e.target == output_console) 14 | { 15 | e.preventDefault(); 16 | e.stopPropagation(); 17 | backspace(); 18 | return false; 19 | } 20 | return true; 21 | } 22 | 23 | var stdout_buffer; 24 | 25 | function predicate_flush_stdout() 26 | { 27 | if (stdout_buffer.innerHTML != "") 28 | stdout("\n"); 29 | return true; 30 | } 31 | 32 | function stdout(msg) 33 | { 34 | output_console.removeChild(stdout_buffer); 35 | var lines = (stdout_buffer.innerHTML + msg).split('\n'); 36 | for (var i = 0; i < lines.length-1; i++) 37 | { 38 | debug(lines[i]); 39 | } 40 | stdout_buffer.innerHTML = lines[lines.length-1]; 41 | output_console.appendChild(stdout_buffer); 42 | 43 | } 44 | 45 | function onload() 46 | { 47 | output_console = document.getElementById('stdout'); 48 | stdout_buffer = document.createElement('div'); 49 | stdout_buffer.innerHTML = ""; 50 | output_console.appendChild(stdout_buffer); 51 | consult(); 52 | 53 | query_node = document.createElement('div'); 54 | query_node.className = "query"; 55 | query_node.innerHTML = "?-"; 56 | output_console.appendChild(query_node); 57 | scroll_to_bottom(); 58 | } 59 | 60 | function debug(e) 61 | { 62 | var newElement = document.createElement('div'); 63 | newElement.innerHTML = '
' + e + '
'; 64 | output_console.appendChild(newElement); 65 | scroll_to_bottom(); 66 | } 67 | 68 | function consult() 69 | { 70 | code_atom = document.getElementById('code').value; 71 | /* Reset the entire WAM */ 72 | load_state(); 73 | initialize(); 74 | atom = lookup_atom(code_atom); 75 | ftor = VAL(lookup_functor("consult_atom", 1)); 76 | allocate_first_frame(); 77 | var pred = predicates[ftor]; 78 | var pi = predicates[ftor].clause_keys[0]; 79 | state.current_predicate = pred; 80 | code = pred.clauses[pi].code; 81 | state.P = 0; 82 | register[0] = atom; 83 | if (wam()) 84 | debug("Buffer consulted"); 85 | else 86 | debug("Failed to load buffer"); 87 | // FIXME: This is not very good. At the very least setting state.B to 0 should reset state.H to 0 as well? 88 | state.B = 0; 89 | can_backtrack = false; 90 | } 91 | 92 | function backspace() 93 | { 94 | if (query.length > 0) 95 | { 96 | query = query.substring(0, query.length - 1); 97 | query_node.innerHTML = "?-" + query; 98 | output_console.removeChild(query_node); 99 | output_console.appendChild(query_node); 100 | scroll_to_bottom(); 101 | } 102 | } 103 | 104 | function keydown(e) 105 | { 106 | if (e.keyCode == 38 && !can_backtrack) 107 | { 108 | e.preventDefault(); 109 | e.stopPropagation(); 110 | h_ptr++; 111 | if (h_ptr >= x_history.length) 112 | { 113 | h_ptr = x_history.length-1; 114 | } 115 | query = x_history[h_ptr]; 116 | query_node.innerHTML = "?-" + query; 117 | output_console.removeChild(query_node); 118 | output_console.appendChild(query_node); 119 | scroll_to_bottom(); 120 | } 121 | else if (e.keyCode == 40 && !can_backtrack) 122 | { 123 | e.preventDefault(); 124 | e.stopPropagation(); 125 | h_ptr--; 126 | if (h_ptr < 0) 127 | { 128 | h_ptr = -1; 129 | query = ""; 130 | } 131 | else 132 | query = x_history[h_ptr]; 133 | query_node.innerHTML = "?-" + query; 134 | output_console.removeChild(query_node); 135 | output_console.appendChild(query_node); 136 | scroll_to_bottom(); 137 | } 138 | } 139 | 140 | function keypress(e) 141 | { 142 | if (e.altKey || e.ctrlKey || e.metaKey) 143 | return; 144 | e.preventDefault(); 145 | e.stopPropagation(); 146 | if (e.keyCode == 8) 147 | { 148 | backspace(); 149 | } 150 | else if (e.keyCode == 59 && can_backtrack) 151 | { 152 | var old_query = document.createElement('div'); 153 | old_query.innerHTML = ";"; 154 | old_query.className = "old_query"; 155 | output_console.appendChild(old_query); 156 | scroll_to_bottom(); 157 | if (backtrack()) 158 | { 159 | try_running(); 160 | } 161 | else 162 | { 163 | stdout("false.\n"); 164 | can_backtrack = false; 165 | query = ""; 166 | query_node = document.createElement('div'); 167 | query_node.className = "query"; 168 | query_node.innerHTML = "?-"; 169 | output_console.appendChild(query_node); 170 | scroll_to_bottom(); 171 | } 172 | } 173 | else if (e.keyCode == 13 && can_backtrack) 174 | { 175 | // Cut choicepoints (?) 176 | state.B = 0; 177 | can_backtrack = false; 178 | query = ""; 179 | query_node = document.createElement('div'); 180 | query_node.className = "query"; 181 | query_node.innerHTML = "?-"; 182 | output_console.appendChild(query_node); 183 | scroll_to_bottom(); 184 | } 185 | else if (e.keyCode == 13) 186 | { 187 | // call the toplevel handler 188 | // ARGH. MUST reset registers for new query, especially after failure! 189 | initialize(); 190 | allocate_first_frame(); 191 | 192 | var ftor = VAL(lookup_functor("repl", 1)); 193 | var pred = predicates[ftor]; 194 | var pi = predicates[ftor].clause_keys[0]; 195 | state.current_predicate = pred; 196 | code = pred.clauses[pi].code; 197 | register[0] = lookup_atom(query); 198 | // Make the query a permanent part of the output 199 | output_console.removeChild(query_node); 200 | var old_query = document.createElement('div'); 201 | old_query.innerHTML = "?-" + query; 202 | old_query.className = "old_query"; 203 | output_console.appendChild(old_query); 204 | x_history.unshift(query); 205 | h_ptr = -1; 206 | try_running(); 207 | } 208 | else 209 | { 210 | query += String.fromCharCode(e.keyCode); 211 | query_node.innerHTML = "?-" + query; 212 | output_console.removeChild(query_node); 213 | output_console.appendChild(query_node); 214 | scroll_to_bottom(); 215 | } 216 | } 217 | 218 | function try_running() 219 | { 220 | try 221 | { 222 | if (!wam()) 223 | { 224 | stdout("false.\n"); 225 | } 226 | } 227 | catch (anything) 228 | { 229 | console.log(anything); 230 | debug("Error. See javascript console"); 231 | } 232 | if (state.B != 0) 233 | { 234 | debug_msg("Can backtrack"); 235 | can_backtrack = true; 236 | } 237 | else 238 | { 239 | debug_msg("No more solutions after this"); 240 | can_backtrack = false; 241 | query = ""; 242 | query_node = document.createElement('div'); 243 | query_node.className = "query"; 244 | query_node.innerHTML = "?-"; 245 | output_console.appendChild(query_node); 246 | scroll_to_bottom(); 247 | } 248 | } 249 | 250 | function scroll_to_bottom() 251 | { 252 | output_console.scrollTop = output_console.scrollHeight; 253 | } 254 | -------------------------------------------------------------------------------- /testing.pl: -------------------------------------------------------------------------------- 1 | % Debugging 2 | :-op(920, fy, ?). 3 | :-op(920, fy, ??). 4 | 5 | ??(Goal):- 6 | setup_call_catcher_cleanup(format(user_error, 'CALL ~q~n', [Goal]), 7 | Goal, 8 | Catcher, 9 | ( Catcher == fail -> 10 | format(user_error, 'FAIL ~q~n', [Goal]) 11 | ; Catcher == exit -> 12 | format(user_error, 'EXIT ~q~n', [Goal]) 13 | ; Catcher == ! -> 14 | format(user_error, 'CUT ~q~n', [Goal]) 15 | ; Catcher = error(Error)-> 16 | format(user_error, 'ERROR ~q ~p~n', [Goal, Error]) 17 | )), 18 | ( var(Catcher)-> 19 | format(user_error, 'PEND ~q~n', [Goal]) 20 | ; otherwise-> 21 | true 22 | ). 23 | 24 | ?(Goal):- 25 | functor(Goal, Functor, Arity), 26 | setup_call_catcher_cleanup(format(user_error, 'CALL ~q~n', [Functor/Arity]), 27 | Goal, 28 | Catcher, 29 | ( Catcher == fail -> 30 | format(user_error, 'FAIL ~q~n', [Goal]) 31 | ; Catcher == exit -> 32 | format(user_error, 'EXIT ~q~n', [Functor/Arity]) 33 | ; Catcher == ! -> 34 | format(user_error, 'CUT ~q~n', [Functor/Arity]) 35 | ; Catcher = error(Error)-> 36 | format(user_error, 'ERROR ~q ~p~n', [Functor/Arity, Error]) 37 | )), 38 | ( var(Catcher)-> 39 | format(user_error, 'PEND ~q~n', [Functor/Arity]) 40 | ; otherwise-> 41 | true 42 | ). 43 | -------------------------------------------------------------------------------- /tests.pl: -------------------------------------------------------------------------------- 1 | term_expansion((test(Label, ExpectedPort):- Body), (test(Label):- (catch(setup_call_catcher_cleanup(format('~w: ', [Label]), 2 | Body, 3 | Port, 4 | check_test_results(Port, ExpectedPort)), 5 | _, 6 | true)->true ; true))). 7 | 8 | run_unit_tests:- 9 | gc, 10 | writeln(running_tests), 11 | debug, 12 | forall(clause(test(Description), _), 13 | run_test(Description)), 14 | statistics. 15 | 16 | run_test(Description):- 17 | test(Description). 18 | 19 | check_test_results(A, A):- true, !, format('OK~n', []). 20 | check_test_results(Got, Expected):- format('FAIL: Expected ~q, got ~q~n', [Expected, Got]), throw(failed_test). 21 | 22 | once_test_1. 23 | once_test_1. 24 | 25 | 26 | test(cut, exit):- 27 | once_test_1, 28 | !. 29 | 30 | findall_test_1(a). 31 | findall_test_1(c). 32 | findall_test_1(b). 33 | findall_test_1(d). 34 | test(findall, exit):- 35 | findall(X, 36 | findall_test_1(X), 37 | Xs), 38 | Xs == [a,c,b,d]. 39 | 40 | 41 | test(once, exit):- 42 | once(once_test_1). 43 | 44 | test(repeat, exit):- 45 | flag(foo, _, 0), 46 | repeat, 47 | flag(foo, N, N+1), 48 | writeln(N), 49 | N =:= 5, 50 | !. 51 | 52 | test(not(1), exit):- 53 | \+(fail). 54 | test(not(2), fail):- 55 | \+(true). 56 | test(not(3), exit):- 57 | \+(\+(A=a)), 58 | var(A). 59 | 60 | test(arg(1), fail):- 61 | arg(0, foo(a,b), _). 62 | test(arg(2), exit):- 63 | arg(1, foo(a,b), a). 64 | test(arg(3), exit):- 65 | arg(2, foo(a,b,c), b). 66 | test(arg(4), fail):- 67 | arg(4, foo(a,b,c), _). 68 | test(arg(5), exit):- 69 | arg(3, foo(a,b,c), c). 70 | 71 | test(subsumes_term(1), exit):- 72 | subsumes_term(a,a). 73 | 74 | test(subsumes_term(2), exit):- 75 | subsumes_term(f(X,Y),f(Z,Z)). 76 | 77 | test(subsumes_term(3), fail):- 78 | subsumes_term(f(Z,Z), f(X,Y)). 79 | 80 | test(subsumes_term(4), fail):- 81 | subsumes_term(g(X),g(f(X))). 82 | 83 | test(subsumes_term(5), fail):- 84 | subsumes_term(X, f(X)). 85 | 86 | test(subsumes_term(6), exit):- 87 | subsumes_term(X, Y), 88 | subsumes_term(Y, f(X)). 89 | 90 | test(sub_atom(1), exit):- 91 | findall(A-B-C-D, 92 | sub_atom(splungesp, A, B, C, D), 93 | R1), 94 | R1 == [0-0-9-'',0-1-8-s,0-2-7-sp,0-3-6-spl,0-4-5-splu,0-5-4-splun,0-6-3-splung,0-7-2-splunge,0-8-1-splunges,0-9-0-splungesp,1-0-8-'',1-1-7-p,1-2-6-pl,1-3-5-plu,1-4-4-plun,1-5-3-plung,1-6-2-plunge,1-7-1-plunges,1-8-0-plungesp,2-0-7-'',2-1-6-l,2-2-5-lu,2-3-4-lun,2-4-3-lung,2-5-2-lunge,2-6-1-lunges,2-7-0-lungesp,3-0-6-'',3-1-5-u,3-2-4-un,3-3-3-ung,3-4-2-unge,3-5-1-unges,3-6-0-ungesp,4-0-5-'',4-1-4-n,4-2-3-ng,4-3-2-nge,4-4-1-nges,4-5-0-ngesp,5-0-4-'',5-1-3-g,5-2-2-ge,5-3-1-ges,5-4-0-gesp,6-0-3-'',6-1-2-e,6-2-1-es,6-3-0-esp,7-0-2-'',7-1-1-s,7-2-0-sp,8-0-1-'',8-1-0-p,9-0-0-'']. 95 | 96 | test(sub_atom(2), exit):- 97 | findall(B-C-D, 98 | sub_atom(splungesp, 2, B, C, D), 99 | R2), 100 | R2 == [0-7-'',1-6-l,2-5-lu,3-4-lun,4-3-lung,5-2-lunge,6-1-lunges,7-0-lungesp]. 101 | 102 | test(sub_atom(3), exit):- 103 | findall(B-C-D, 104 | sub_atom(splungesp, B, 2, C, D), 105 | R3), 106 | R3 = [0-7-sp,1-6-pl,2-5-lu,3-4-un,4-3-ng,5-2-ge,6-1-es,7-0-sp]. 107 | 108 | test(sub_atom(4), exit):- 109 | findall(B-C-D, 110 | sub_atom(splungesp, B, C, 2, D), 111 | R4), 112 | R4 = [0-7-splunge,1-6-plunge,2-5-lunge,3-4-unge,4-3-nge,5-2-ge,6-1-e,7-0-'']. 113 | 114 | test(sub_atom(5), exit):- 115 | findall(B-C-D, 116 | sub_atom(splungesp, B, C, D, sp), 117 | R5), 118 | R5 = [0-2-7,7-2-0]. 119 | 120 | test(sub_atom(6), exit):- 121 | findall(C-D, 122 | sub_atom(splungesp, 2, C, 2, D), 123 | R6), 124 | R6 = [5-lunge]. 125 | 126 | test(sub_atom(7), exit):- 127 | findall(C-D, 128 | sub_atom(splungesp, C, 2, 2, D), 129 | R7), 130 | R7 == [5-ge]. 131 | 132 | test(sub_atom(8), exit):- 133 | findall(C-D, 134 | sub_atom(splungesp, 2, 2, C, D), 135 | R8), 136 | R8 == [5-lu]. 137 | 138 | test(sub_atom(9), exit):- 139 | findall(D, 140 | sub_atom(splungesp, 2, 2, 2, D), 141 | R9), 142 | R9 == []. 143 | 144 | 145 | test(arithmetic_test(1), exit):- 146 | X is 1+2, 147 | X == 3 . 148 | test(arithmetic_test(2), exit):- 149 | Y is 3*9+1, 150 | Y == 28 . 151 | 152 | test(arithmetic_test(3), exception(type_error(evaluable,t/0))):- 153 | Z is 3 + t . 154 | 155 | test(arithmetic_test(4), exit):- 156 | Y is max(2, 7), 157 | Y == 7 . 158 | setup_call_catcher_cleanup(true, 159 | setup_call_catcher_cleanup(true, 160 | true, 161 | C1, 162 | Cleanup = ok), 163 | C2, 164 | Cleanup2 = ok), 165 | !, 166 | writeln(C2-Cleanup2). 167 | test(arithmetic_test(5), exit):- 168 | Y is sin(pi), 169 | Y < 0.0001, 170 | Y > -0.0001 . 171 | 172 | test(univ(1), exit):- 173 | foo(bar) =.. A, 174 | A == [foo, bar]. 175 | 176 | test(univ(2), exit):- 177 | foo =.. A, 178 | A == [foo]. 179 | 180 | test(univ(3), exit):- 181 | A =.. [foo, bar], 182 | A == foo(bar). 183 | 184 | test(univ(4), exit):- 185 | A =.. [foo, bar, baz], 186 | A == foo(bar, baz). 187 | 188 | test(univ(5), exit):- 189 | [a, b, c] =.. A, 190 | A == ['.', a, [b,c]]. 191 | 192 | deterministic_goal. 193 | nondeterministic_goal. 194 | nondeterministic_goal. 195 | goal_that_fails:- fail. 196 | goal_raising_exception:- throw(egg). 197 | check_value(A, B):- A == B, !. 198 | check_value(A, B):- throw(mismatch(A,B)). 199 | 200 | 201 | test(deterministic_setup_call_cleanup, exit):- 202 | setup_call_catcher_cleanup(Setup=ok, 203 | deterministic_goal, 204 | Catcher, 205 | Cleanup=ok), 206 | Setup == ok, 207 | Cleanup == ok, 208 | Catcher == exit. 209 | 210 | test(nondeterministic_setup_call_cleanup, exit):- 211 | setup_call_catcher_cleanup(Setup=ok, 212 | nondeterministic_goal, 213 | Catcher, 214 | Cleanup=ok), 215 | Setup == ok, 216 | var(Catcher), 217 | var(Cleanup), 218 | !, 219 | Cleanup == ok, 220 | Catcher == !. 221 | 222 | test(failing_setup_call_cleanup, fail):- 223 | setup_call_catcher_cleanup(Setup=ok, 224 | goal_that_fails, 225 | Catcher, 226 | ( check_value(Setup, ok), 227 | check_value(Catcher, fail))). 228 | 229 | 230 | error_setup_call_cleanup_test_1:- 231 | setup_call_catcher_cleanup(Setup=ok, 232 | goal_raising_exception, 233 | Catcher, 234 | ( check_value(Setup, ok), 235 | check_value(Catcher, exception(egg)))), 236 | throw(unexpected_success). 237 | 238 | test(error_setup_call_cleanup, exit):- 239 | catch(error_setup_call_cleanup_test_1, 240 | Exception, 241 | Error = Exception), 242 | check_value(Error, egg). 243 | -------------------------------------------------------------------------------- /wam_bootstrap.pl: -------------------------------------------------------------------------------- 1 | /*---------------------------------------------------------- 2 | This file is intended for use when bootstrapping only. 3 | It should not be loaded into the generated compiler. 4 | Consequently the following predicates must be implemented 5 | by the target system: 6 | * lookup_atom(+Atom, -AtomIndex) 7 | * lookup_float(+Float, -FloatIndex) 8 | * lookup_functor(+FunctorName, +FunctorArity, -FunctorIndex) 9 | * Note that FunctorName is an atom, not an index 10 | * add_clause_to_predicate(Name/Arity, +Head, +Body) 11 | * emit_code(+Address, +Code) 12 | ---------------------------------------------------------- */ 13 | 14 | :-dynamic(ftable/2). % functors 15 | :-dynamic(fltable/2). % floats 16 | :-dynamic(atable/2). % atoms 17 | :-dynamic(clause_table/3). % clauses 18 | :-dynamic(fptable/2). % foreign predicates 19 | :-dynamic(ctable/2). % code 20 | 21 | lookup_functor(Functor, Arity, N):- 22 | lookup_atom(Functor, F), 23 | ( ftable(F/Arity, N)-> 24 | true 25 | ; otherwise-> 26 | flag(ftable, N, N+1), 27 | assert(ftable(F/Arity, N)) 28 | ). 29 | 30 | lookup_atom([], 0):- !. 31 | lookup_atom(Atom, N):- 32 | ( atable(Atom, N)-> 33 | true 34 | ; otherwise-> 35 | flag(atable, N, N+1), 36 | assert(atable(Atom, N)) 37 | ). 38 | 39 | lookup_float(Float, N):- 40 | ( fltable(Float, N)-> 41 | true 42 | ; otherwise-> 43 | flag(fltable, N, N+1), 44 | assert(fltable(Float, N)) 45 | ). 46 | 47 | 48 | emit_code(N, Code):- 49 | assert(ctable(N, Code)). 50 | 51 | add_clause_to_predicate(Name/Arity, _, _):- 52 | setof(N-Code, T^(ctable(T, Code), N is T /\ 0x7fffffff), SortedCodes), 53 | findall(Code, member(_-Code, SortedCodes), Codes), 54 | lookup_functor(Name, Arity, Predicate), 55 | ( retract(clause_table(Predicate, I, [254,0|PreviousCodes]))-> 56 | % If there is a NOP clause, then we have only one clause. Make it try_me_else, then add our new one as trust_me. 57 | II is I+1, 58 | assertz(clause_table(Predicate, I, [28, II|PreviousCodes])), 59 | assertz(clause_table(Predicate, II, [30, 0|Codes])) 60 | ; retract(clause_table(Predicate, I, [30,0|PreviousCodes]))-> 61 | II is I+1, 62 | % If we have a trust_me, then make it retry_me_else (since there must have been another clause to try first, if we then have to trust_me) 63 | assertz(clause_table(Predicate, I, [29, II|PreviousCodes])), 64 | assertz(clause_table(Predicate, II, [30, 0|Codes])) 65 | ; otherwise-> 66 | % Otherwise there are no clauses yet. So just add ours as a 67 | assertz(clause_table(Predicate, 0, [254, 0|Codes])) 68 | ). 69 | 70 | add_clause_to_aux(AuxLabel, N, L, LT):- 71 | ( nonvar(AuxLabel), 72 | AuxLabel = defined(A) -> 73 | NN is N xor 0x80000000, 74 | add_clause_to_existing(A, NN), 75 | L = LT 76 | ; otherwise-> 77 | % Brand new aux! This gets and sets L 78 | NN is N+1, 79 | assert(ctable(N, 254)), 80 | assert(ctable(NN, 0)), 81 | AuxLabel = defined(N), 82 | L = [label(AuxLabel, N)|LT] 83 | ). 84 | 85 | 86 | add_clause_to_existing(A, N):- 87 | AA is A+1, 88 | NN is N+1, 89 | ( ctable(A, 254)-> 90 | % Change -> 91 | retract(ctable(A, _)), 92 | retract(ctable(AA, _)), 93 | assert(ctable(A, 28)), 94 | assert(ctable(AA, N)), 95 | % Add at N 96 | assert(ctable(N, 30)), 97 | assert(ctable(NN, 0)) 98 | ; ctable(A, 28)-> 99 | % Follow path 100 | ctable(AA, Link), 101 | add_clause_to_existing(Link, N) 102 | ; ctable(A, 29)-> 103 | % Follow link 104 | ctable(AA, Link), 105 | add_clause_to_existing(Link, N) 106 | ; ctable(A, 30)-> 107 | % Change -> 108 | retract(ctable(A, _)), 109 | retract(ctable(AA, _)), 110 | assert(ctable(A, 29)), 111 | assert(ctable(AA, N)), 112 | % Add at N 113 | assert(ctable(N, 30)), 114 | assert(ctable(NN, 0)) 115 | ). 116 | 117 | 118 | quote_atom_for_javascript([], '"[]"'):- !. 119 | quote_atom_for_javascript(Atom, QuotedAtom):- 120 | atom_codes(Atom, Codes), 121 | quote_atom_for_javascript_1(QuotedCodes, Codes, []), 122 | atom_codes(QuotedAtom, QuotedCodes). 123 | 124 | quote_atom_for_javascript_1([34|Codes])--> 125 | quote_atom_for_javascript_2(Codes). 126 | 127 | quote_atom_for_javascript_2([92, 110|Codes])--> 128 | "\n", !, 129 | quote_atom_for_javascript_2(Codes). 130 | 131 | quote_atom_for_javascript_2([92, 92|Codes])--> 132 | "\\", !, 133 | quote_atom_for_javascript_2(Codes). 134 | 135 | quote_atom_for_javascript_2([92, 34|Codes])--> 136 | [34], !, % ' 137 | quote_atom_for_javascript_2(Codes). 138 | 139 | 140 | quote_atom_for_javascript_2([Code|Codes])--> 141 | [Code], 142 | quote_atom_for_javascript_2(Codes). 143 | 144 | quote_atom_for_javascript_2([34], [], []):- !. 145 | 146 | 147 | dump_tables(S):- 148 | ( setof(N-Atom, atable(Atom, N), Atoms)-> true ; otherwise-> Atoms = []), 149 | findall(QuotedAtom, 150 | ( member(_-Atom, Atoms), 151 | quote_atom_for_javascript(Atom, QuotedAtom) 152 | ), 153 | SortedAtoms), 154 | atomic_list_concat(SortedAtoms, ', ', AtomAtom), 155 | format(S, 'atable = [~w];~n', [AtomAtom]), 156 | ( setof(N-Float, fltable(Float, N), Floats)-> true ; otherwise-> Floats = []), 157 | findall(Float, member(_-Float, Floats), FloatAtoms), 158 | atomic_list_concat(FloatAtoms, ', ', FloatAtom), 159 | format(S, 'floats = [~w];~n', [FloatAtom]), 160 | 161 | ( setof(N-F, ftable(F, N), Functors)-> true ; otherwise-> Functors = []), 162 | findall(Functor, (member(_-F/A, Functors), 163 | format(atom(Functor), '[~w,~w]', [F, A])), 164 | SortedFunctors), 165 | atomic_list_concat(SortedFunctors, ', ', FunctorAtom), 166 | format(S, 'ftable = [~w];~n', [FunctorAtom]), 167 | findall(PredicateAtom, 168 | ( bagof(Clause-Index, 169 | clause_table(Functor, Index, Clause), 170 | Clauses), 171 | aggregate_all(r(bag(ClauseAtom), 172 | bag(I)), 173 | ( member(Clause-I, Clauses), 174 | format(atom(ClauseAtom), '~w:{code:~w, key:~w}', [I, Clause, I]) 175 | ), 176 | r(ClauseAtoms, IndexAtoms)), 177 | atomic_list_concat(IndexAtoms, ', ', IndexAtom), 178 | atomic_list_concat(ClauseAtoms, ', ', ClauseAtom), 179 | list_length(Clauses, I), 180 | format(atom(PredicateAtom), '~w: {clauses:{~w}, clause_keys:[~w], next_key:~w, key:~w}', [Functor, ClauseAtom, IndexAtom, I, Functor]) 181 | ), 182 | Predicates), 183 | atomic_list_concat(Predicates, ', ', PredicatesAtom), 184 | format(S, 'predicates = {~w};~n', [PredicatesAtom]), 185 | findall(PredicateAtom, 186 | ( fptable(Predicate, Symbol), 187 | format(atom(PredicateAtom), '~w: ~w', [Predicate, Symbol]) 188 | ), 189 | FPredicates), 190 | atomic_list_concat(FPredicates, ', ', FPredicatesAtom), 191 | format(S, 'foreign_predicates = {~w};~n', [FPredicatesAtom]). 192 | 193 | reserve_predicate(Functor/Arity, Foreign):- 194 | lookup_functor(Functor, Arity, F), 195 | assert(fptable(F, Foreign)). 196 | 197 | reset_compile_buffer:- 198 | retractall(ctable(_, _)). 199 | 200 | reset:- 201 | retractall(ctable(_, _)), 202 | retractall(clause_table(_,_,_)), 203 | retractall(atable(_,_)), 204 | retractall(ftable(_,_)), 205 | retractall(fptable(_,_)), 206 | % [] is always 0 207 | assert(atable('[]', 0)), 208 | 209 | flag(ftable, _, 0), 210 | flag(atable, _, 1), 211 | 212 | % Then add in some reserved predicates 213 | 214 | % ISO foreign predicates 215 | reserve_predicate(acyclic_term/1, predicate_acyclic_term), 216 | reserve_predicate(subsumes_term/2, predicate_subsumes_term), 217 | reserve_predicate(compare/3, predicate_compare), 218 | reserve_predicate(var/1, predicate_var), 219 | reserve_predicate(atom/1, predicate_atom), 220 | reserve_predicate(integer/1, predicate_integer), 221 | reserve_predicate(float/1, predicate_float), 222 | reserve_predicate(compound/1, predicate_compound), 223 | reserve_predicate(ground/1, predicate_ground), 224 | reserve_predicate((=)/2, predicate_unify), 225 | reserve_predicate((==)/2, predicate_match), 226 | reserve_predicate(functor/3, predicate_functor), 227 | reserve_predicate(arg/3, predicate_arg), 228 | reserve_predicate((=..)/2, predicate_univ), 229 | reserve_predicate(copy_term/2, predicate_copy_term), 230 | reserve_predicate(halt/1, predicate_halt), 231 | reserve_predicate(current_prolog_flag/2, predicate_current_prolog_flag), 232 | reserve_predicate(set_prolog_flag/2, predicate_set_prolog_flag), 233 | reserve_predicate(repeat/0, predicate_repeat), 234 | reserve_predicate(atom_length/2, predicate_atom_length), 235 | reserve_predicate(atom_concat/3, predicate_atom_concat), 236 | reserve_predicate(sub_atom/5, predicate_sub_atom), 237 | reserve_predicate(char_code/2, predicate_char_code), 238 | reserve_predicate(atom_chars/2, predicate_atom_chars), 239 | reserve_predicate(atom_codes/2, predicate_atom_codes), 240 | reserve_predicate(number_chars/2, predicate_number_chars), 241 | reserve_predicate(number_codes/2, predicate_number_codes), 242 | 243 | reserve_predicate(char_conversion/2, predicate_char_conversion), 244 | reserve_predicate(current_char_conversion/2, predicate_current_char_conversion), 245 | 246 | reserve_predicate(current_predicate/1, predicate_current_predicate), 247 | 248 | reserve_predicate((@>)/2, predicate_term_gt), 249 | reserve_predicate((@>=)/2, predicate_term_egt), 250 | reserve_predicate((@<)/2, predicate_term_lt), 251 | reserve_predicate((@=<)/2, predicate_term_elt), 252 | 253 | reserve_predicate(is/2, predicate_is), 254 | reserve_predicate((>)/2, predicate_gt), 255 | reserve_predicate((<)/2, predicate_lt), 256 | reserve_predicate((=<)/2, predicate_elt), 257 | reserve_predicate((>=)/2, predicate_egt), 258 | reserve_predicate((=:=)/2, predicate_eq), 259 | reserve_predicate((=\=)/2, predicate_ne), 260 | 261 | reserve_predicate(set_input/1, predicate_set_input), 262 | reserve_predicate(set_output/1, predicate_set_output), 263 | reserve_predicate(current_output/1, predicate_current_output), 264 | reserve_predicate(current_input/1, predicate_current_input), 265 | reserve_predicate(get_char/2, predicate_get_char), 266 | reserve_predicate(get_code/2, predicate_get_code), 267 | reserve_predicate(peek_char/2, predicate_peek_char), 268 | reserve_predicate(peek_code/2, predicate_peek_code), 269 | reserve_predicate(put_char/2, predicate_put_char), 270 | reserve_predicate(put_code/2, predicate_put_code), 271 | 272 | reserve_predicate(get_byte/2, predicate_get_byte), 273 | reserve_predicate(peek_byte/2, predicate_peek_byte), 274 | reserve_predicate(put_byte/2, predicate_put_byte), 275 | 276 | reserve_predicate(flush_output/1, predicate_flush_output), 277 | reserve_predicate(at_end_of_stream/1, predicate_at_end_of_stream), 278 | reserve_predicate(set_stream_position/2, predicate_set_stream_position), 279 | reserve_predicate(stream_property_1/2, predicate_stream_property), 280 | reserve_predicate(current_stream/1, predicate_current_stream), 281 | reserve_predicate(write_term/3, predicate_write_term), 282 | reserve_predicate(current_op/3, predicate_current_op), 283 | 284 | reserve_predicate(fail/0, predicate_fail), 285 | reserve_predicate(true/0, predicate_true), 286 | reserve_predicate(term_variables/2, predicate_term_variables), 287 | reserve_predicate(writeln/1, writeln), 288 | reserve_predicate(gensym/2, predicate_gensym), 289 | reserve_predicate(atom_to_term/3, atom_to_term), 290 | reserve_predicate(clause/2, predicate_clause), 291 | reserve_predicate(abolish/1, predicate_abolish), 292 | reserve_predicate(retract_clause/2, predicate_retract_clause), 293 | reserve_predicate(read_term/3, read_term), 294 | reserve_predicate(close/2, predicate_close), 295 | reserve_predicate(op/3, predicate_op), 296 | 297 | % Some handy extensions 298 | reserve_predicate(atom_to_memory_file/2, atom_to_memory_file), 299 | reserve_predicate(memory_file_to_atom/2, memory_file_to_atom), 300 | reserve_predicate(new_memory_file/1, new_memory_file), 301 | reserve_predicate(open_memory_file/3, open_memory_file), 302 | reserve_predicate(free_memory_file/1, free_memory_file), 303 | reserve_predicate(format/3, predicate_format), 304 | reserve_predicate(flag/3, predicate_flag), 305 | 306 | % Stuff related to actually compiling 307 | reserve_predicate(reset_compile_buffer/0, reset_compile_buffer), 308 | reserve_predicate(emit_code/2, emit_code), 309 | reserve_predicate(lookup_atom/2, predicate_lookup_atom), 310 | reserve_predicate(lookup_float/2, predicate_lookup_float), 311 | reserve_predicate(lookup_functor/3, predicate_lookup_functor), 312 | reserve_predicate(add_clause_to_predicate/3, add_clause_to_predicate), 313 | reserve_predicate(add_clause_to_aux/4, add_clause_to_aux), 314 | reserve_predicate(prepend_clause_to_predicate/3, prepend_clause_to_predicate), 315 | reserve_predicate(flush_stdout/0, predicate_flush_stdout), 316 | reserve_predicate(debug/0, predicate_debug), 317 | reserve_predicate(nodebug/0, predicate_nodebug), 318 | reserve_predicate('$jmp'/1, predicate_jmp), 319 | 320 | % Debugging 321 | reserve_predicate(trace_unify/2, predicate_trace_unify), 322 | 323 | % Testing 324 | reserve_predicate(member/2, member), 325 | 326 | % Call cleanup 327 | reserve_predicate(mark_top_choicepoint/2, mark_top_choicepoint), 328 | reserve_predicate(unmark_choicepoint/1, unmark_choicepoint), 329 | reserve_predicate(unmark_top_choicepoint/0, unmark_top_choicepoint), 330 | 331 | % Exceptions 332 | reserve_predicate(get_current_block/1, get_current_block), 333 | reserve_predicate(install_new_block/1, install_new_block), 334 | reserve_predicate(reset_block/1, reset_block), 335 | reserve_predicate(unwind_stack/0, unwind_stack), 336 | reserve_predicate(clean_up_block/1, clean_up_block), 337 | reserve_predicate(throw/1, predicate_throw), 338 | reserve_predicate(get_exception/1, get_exception), 339 | reserve_predicate(clear_exception/0, clear_exception), 340 | 341 | % Recorded database 342 | reserve_predicate(recorda/3, recorda), 343 | reserve_predicate(recordz/3, recordz), 344 | reserve_predicate(recorded/3, recorded), 345 | reserve_predicate(erase/1, erase), 346 | 347 | % GC 348 | reserve_predicate(gc/0, predicate_gc), 349 | reserve_predicate(statistics/0, predicate_statistics), 350 | true. 351 | 352 | 353 | build_saved_state(SourceFiles, TopLevelQuery):- 354 | reset, 355 | assemble([call(toplevel/0,0), execute(halt/0), retry_foreign], 2), 356 | setof(N-Code, ctable(N, Code), SortedBootCodes), 357 | findall(Code, member(_-Code, SortedBootCodes), BootCodes), 358 | atomic_list_concat(BootCodes, ',', BootCode), 359 | compile_clause(toplevel:-TopLevelQuery), 360 | ( compile_files(SourceFiles)-> 361 | true 362 | ; otherwise-> 363 | writeln(failed_to_compile), 364 | halt, 365 | fail 366 | ), 367 | !, 368 | open('bootstrap.js', write, S1), 369 | format(S1, 'function load_state() {~n', []), 370 | format(S1, 'bootstrap_code = [0,255,~w];~n', [BootCode]), 371 | format(S1, 'retry_foreign_offset = 7;~n', []), 372 | % format(S1, 'retry_foreign = {code: bootstrap_code, offset:7};~n', []), 373 | dump_tables(S1), 374 | format(S1, '}~n', []), 375 | close(S1), 376 | !. 377 | 378 | 379 | % eg bootstrap('demo.pl', (factorial(5, X), writeln(X))). 380 | % Ultimately, bootstrap('prolog.pl', prolog_toplevel). 381 | bootstrap(Source, Query):- 382 | % Since javascript will not support open/3, we must load it into an atom and pass it. 383 | % Ultimately we could use XmlHTTPRequest, but probably that is less useful anyway 384 | file_to_atom(Source, Atom), 385 | build_saved_state(['wam_compiler.pl', 386 | 'bootstrap_js.pl'], 387 | ( writeln(toplevel), 388 | compile_clause(bootstrap:-Query), 389 | statistics, 390 | compile_atom(Atom), 391 | statistics, 392 | !, 393 | bootstrap)). 394 | 395 | 396 | file_to_atom(Filename, Atom):- 397 | open(Filename, read, R), 398 | new_memory_file(MemFile), 399 | open_memory_file(MemFile, write, W), 400 | copy_stream_data(R, W), 401 | close(W), 402 | close(R), 403 | memory_file_to_atom(MemFile, Atom), 404 | free_memory_file(MemFile). 405 | 406 | 407 | trace_unify(A, A). 408 | 409 | compile_message(A):- writeln(A). 410 | %compile_message(_). 411 | flush_stdout. 412 | gc. --------------------------------------------------------------------------------