From a1a2c87524c0cd86a468fb3107a697f3047d66f9 Mon Sep 17 00:00:00 2001 From: Gabriel Pariat Date: Sun, 20 Feb 2022 08:52:17 -0500 Subject: [PATCH] git clean up (not first) --- .gitignore | 3 + LICENSE | 661 +++++ favicon.ico | Bin 0 -> 3006 bytes implementations/c/.gitignore | 26 + implementations/c/AUTHORS | 0 implementations/c/COPYING | 661 +++++ implementations/c/ChangeLog | 0 implementations/c/INSTALL | 0 implementations/c/Makefile.am | 2 + implementations/c/NEWS | 0 implementations/c/README | 0 implementations/c/check | 3 + implementations/c/configure.ac | 11 + implementations/c/debug | 3 + implementations/c/lisp.lisp | 9 + implementations/c/run | 2 + implementations/c/src/Makefile.am | 18 + implementations/c/src/array.c | 60 + implementations/c/src/cons.c | 34 + implementations/c/src/environment.c | 32 + implementations/c/src/evaluator.c | 62 + implementations/c/src/evaluator.h | 7 + implementations/c/src/lisp.c | 305 ++ implementations/c/src/lisp.h | 257 ++ implementations/c/src/macros.h | 18 + implementations/c/src/main.c | 10 + implementations/c/src/memory.c | 329 +++ implementations/c/src/printer.c | 68 + implementations/c/src/printer.h | 6 + implementations/c/src/reader.c | 263 ++ implementations/c/src/reader.h | 9 + implementations/c/src/string.c | 25 + implementations/c/src/symbol.c | 57 + implementations/c/src/table.c | 97 + implementations/c/tests/Makefile.am | 17 + implementations/c/tests/array-test.c | 94 + implementations/c/tests/check_ptlisp.log | Bin 0 -> 9173 bytes implementations/c/tests/check_ptlisp.trs | 4 + implementations/c/tests/cons-test.c | 53 + implementations/c/tests/environment-test.c | 45 + implementations/c/tests/evaluator-test.c | 72 + implementations/c/tests/lisp-test.c | 255 ++ implementations/c/tests/memory-test.c | 253 ++ implementations/c/tests/printer-test.c | 61 + implementations/c/tests/ptlisp-test.c | 25 + implementations/c/tests/ptlisp-test.h | 16 + implementations/c/tests/reader-test.c | 157 + implementations/c/tests/string-test.c | 49 + implementations/c/tests/symbol-test.c | 62 + implementations/c/tests/table-test.c | 78 + implementations/c/tests/test-suite.log | 14 + implementations/js/datatypes.js | 151 + implementations/js/env.js | 29 + implementations/js/evaluator.js | 64 + implementations/js/index.html | 87 + implementations/js/main.js | 308 ++ implementations/js/printer.js | 96 + implementations/js/reader.js | 49 + implementations/js/repl.js | 409 +++ implementations/wasm/lisp.js | 156 + implementations/wasm/lisp.wat | 2984 ++++++++++++++++++++ presentation.org | 153 + test.ptlisp | 100 + 63 files changed, 8879 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 favicon.ico create mode 100644 implementations/c/.gitignore create mode 100644 implementations/c/AUTHORS create mode 100644 implementations/c/COPYING create mode 100644 implementations/c/ChangeLog create mode 100644 implementations/c/INSTALL create mode 100644 implementations/c/Makefile.am create mode 100644 implementations/c/NEWS create mode 100644 implementations/c/README create mode 100755 implementations/c/check create mode 100644 implementations/c/configure.ac create mode 100755 implementations/c/debug create mode 100644 implementations/c/lisp.lisp create mode 100755 implementations/c/run create mode 100644 implementations/c/src/Makefile.am create mode 100644 implementations/c/src/array.c create mode 100644 implementations/c/src/cons.c create mode 100644 implementations/c/src/environment.c create mode 100644 implementations/c/src/evaluator.c create mode 100644 implementations/c/src/evaluator.h create mode 100644 implementations/c/src/lisp.c create mode 100644 implementations/c/src/lisp.h create mode 100644 implementations/c/src/macros.h create mode 100644 implementations/c/src/main.c create mode 100644 implementations/c/src/memory.c create mode 100644 implementations/c/src/printer.c create mode 100644 implementations/c/src/printer.h create mode 100644 implementations/c/src/reader.c create mode 100644 implementations/c/src/reader.h create mode 100644 implementations/c/src/string.c create mode 100644 implementations/c/src/symbol.c create mode 100644 implementations/c/src/table.c create mode 100644 implementations/c/tests/Makefile.am create mode 100644 implementations/c/tests/array-test.c create mode 100644 implementations/c/tests/check_ptlisp.log create mode 100644 implementations/c/tests/check_ptlisp.trs create mode 100644 implementations/c/tests/cons-test.c create mode 100644 implementations/c/tests/environment-test.c create mode 100644 implementations/c/tests/evaluator-test.c create mode 100644 implementations/c/tests/lisp-test.c create mode 100644 implementations/c/tests/memory-test.c create mode 100644 implementations/c/tests/printer-test.c create mode 100644 implementations/c/tests/ptlisp-test.c create mode 100644 implementations/c/tests/ptlisp-test.h create mode 100644 implementations/c/tests/reader-test.c create mode 100644 implementations/c/tests/string-test.c create mode 100644 implementations/c/tests/symbol-test.c create mode 100644 implementations/c/tests/table-test.c create mode 100644 implementations/c/tests/test-suite.log create mode 100644 implementations/js/datatypes.js create mode 100644 implementations/js/env.js create mode 100644 implementations/js/evaluator.js create mode 100644 implementations/js/index.html create mode 100644 implementations/js/main.js create mode 100644 implementations/js/printer.js create mode 100644 implementations/js/reader.js create mode 100644 implementations/js/repl.js create mode 100644 implementations/wasm/lisp.js create mode 100644 implementations/wasm/lisp.wat create mode 100644 presentation.org create mode 100644 test.ptlisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bc1c9dc --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.out +*.wasm +*.o \ No newline at end of file diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..be3f7b2 --- /dev/null +++ b/LICENSE @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. diff --git a/favicon.ico b/favicon.ico new file mode 100644 index 0000000000000000000000000000000000000000..470268daacb5d6b328419fb2c7c6eb3e75544a0a GIT binary patch literal 3006 zcmeH}XHyeV6oyYI(m^RglwhPuFH*B08Wf}i1%yyS6U#V`Gdg1#d;jKN@CW!aecrpf z34ZZ2A99%I-t4`}?%C(goP$|}zpgH0EVVxsX6Ma}OUEj+*8dw3b_<{oil7+IKndul zWx#!{5~`pYYM>VCpdR$lMreWy&Zvp#wUh2l}8N24E0|U>HVV6eeI2 z65zoUOv5#pf$NZjS-1srFb}t30Ty8imf;TE1&LXMb+`v<*n>kjf@63958)9!h9~e8 zp22f?0WaYdyoNXM7T&>o_y8Z_6MTj*@D;wnclZH6;TQadeB=$}4V*Ru<*gM_?}}1oxJgWTfc?2fzGR{hIH^{yRKaFF1(a=s#2L{+~^PW6yw4+ugeu&Emi7Xt;)}u3jObB+@)AAQYfQa!P+{NcYMWN zsOAOHtd#W*t17@mu{MuLnDVQ-8N@~#rC0SdOmBhrX;(2d+pKew26cjRwT4);E_u9q ziCo6XFBcgyP17E_*8_iB4Su@uf1F$;1N@oopY#1S@_782ZN+mp;|1tk__L->D{={L zu#G<}^G_uB?nP$#8;yFsiC!{nVZr%}X)7DbN&fD;l}w54^TGFb@+ju%KhB^3!vrVM`BO`kGUX(HiI~@(J#PO%oxiE$xo%FN zNP^@~CztcLHe}}en^?gg-SH+JJA7QupWe;+yD^r+pV^Mmjq`yh&G{o6C#lE7jPfH_ z=daJ}CckVTPyYN+ekc5e%bHV3`3pk%o$wbfYpzPmpNpYJ<%ho--(RpCPKn{M(cy^! WuXZF@85ti;=>M901AhUO=3gBE literal 0 HcmV?d00001 diff --git a/implementations/c/.gitignore b/implementations/c/.gitignore new file mode 100644 index 0000000..2c2ef84 --- /dev/null +++ b/implementations/c/.gitignore @@ -0,0 +1,26 @@ +*.o +*.lo +*.la +ptlisp +check_ptlisp +.deps +Makefile.in +Makefile +aclocal.m4 +autom4te.cache/ +autoscan.log +compile +config.guess +config.log +config.status +config.sub +configure +configure.scan +depcomp +install-sh +missing +test-driver +ltmain.sh +libtool +.libs/ +tmp/ diff --git a/implementations/c/AUTHORS b/implementations/c/AUTHORS new file mode 100644 index 0000000..e69de29 diff --git a/implementations/c/COPYING b/implementations/c/COPYING new file mode 100644 index 0000000..dba13ed --- /dev/null +++ b/implementations/c/COPYING @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. diff --git a/implementations/c/ChangeLog b/implementations/c/ChangeLog new file mode 100644 index 0000000..e69de29 diff --git a/implementations/c/INSTALL b/implementations/c/INSTALL new file mode 100644 index 0000000..e69de29 diff --git a/implementations/c/Makefile.am b/implementations/c/Makefile.am new file mode 100644 index 0000000..494df61 --- /dev/null +++ b/implementations/c/Makefile.am @@ -0,0 +1,2 @@ +SUBDIRS = src . tests + diff --git a/implementations/c/NEWS b/implementations/c/NEWS new file mode 100644 index 0000000..e69de29 diff --git a/implementations/c/README b/implementations/c/README new file mode 100644 index 0000000..e69de29 diff --git a/implementations/c/check b/implementations/c/check new file mode 100755 index 0000000..d0a75e1 --- /dev/null +++ b/implementations/c/check @@ -0,0 +1,3 @@ +#!/bin/sh +make check +./tests/check_ptlisp \ No newline at end of file diff --git a/implementations/c/configure.ac b/implementations/c/configure.ac new file mode 100644 index 0000000..c706eea --- /dev/null +++ b/implementations/c/configure.ac @@ -0,0 +1,11 @@ +AC_INIT([ptlisp], [0.1], [gabriel@pariatech.com]) + +AM_INIT_AUTOMAKE +LT_INIT + +AC_PROG_CC +PKG_CHECK_MODULES([CHECK], [check >= 0.9.6]) + +AC_CONFIG_FILES([Makefile src/Makefile tests/Makefile]) + +AC_OUTPUT diff --git a/implementations/c/debug b/implementations/c/debug new file mode 100755 index 0000000..553a419 --- /dev/null +++ b/implementations/c/debug @@ -0,0 +1,3 @@ +#!/bin/sh + +make; ./libtool --mode=execute gdb ./src/ptlisp -ex run diff --git a/implementations/c/lisp.lisp b/implementations/c/lisp.lisp new file mode 100644 index 0000000..8cfea06 --- /dev/null +++ b/implementations/c/lisp.lisp @@ -0,0 +1,9 @@ +(set-reader-macro \' (fn (stream c) (list (quote quote) (read stream)))) + +(def map (fn (list f) + (let ((loop (fn ((list result)) + (if list + (loop (cdr list) (cons (f (car list)) result)) + result)))) + (loop list nil)))) + diff --git a/implementations/c/run b/implementations/c/run new file mode 100755 index 0000000..ac81fd4 --- /dev/null +++ b/implementations/c/run @@ -0,0 +1,2 @@ +#!/bin/sh +make; ./src/ptlisp \ No newline at end of file diff --git a/implementations/c/src/Makefile.am b/implementations/c/src/Makefile.am new file mode 100644 index 0000000..590d4d4 --- /dev/null +++ b/implementations/c/src/Makefile.am @@ -0,0 +1,18 @@ +lib_LTLIBRARIES = libptlisp.la +libptlisp_la_SOURCES = \ + memory.c \ + array.c \ + table.c \ + symbol.c \ + string.c \ + cons.c \ + environment.c \ + evaluator.c \ + lisp.c \ + reader.c \ + printer.c + +bin_PROGRAMS = ptlisp +ptlisp_SOURCES = main.c +ptlisp_CFLAGS = -Wall +ptlisp_LDADD = libptlisp.la -lm diff --git a/implementations/c/src/array.c b/implementations/c/src/array.c new file mode 100644 index 0000000..8bad587 --- /dev/null +++ b/implementations/c/src/array.c @@ -0,0 +1,60 @@ +#include +#include "lisp.h" + +Pointer array(size_t size) { + Pointer ptr = memory_new(ARRAY, sizeof(Array) + size * sizeof(Pointer)); + ARRAY(ptr).length = 0; + ARRAY(ptr).size = size; + return ptr; +} + +Pointer array_push(Pointer pArray, Pointer pData) { + Array* array = &ARRAY(pArray); + if (array->size == array->length) { + array->size = MAX(array->size * 2, 1); + pArray = memory_resize(pArray, sizeof(Array) + array->size * sizeof(Pointer)); + array = &ARRAY(pArray); + } + + array->data[array->length++] = pData; + return pArray; +} + +Pointer array_pop(Pointer pArray) { + Array* array = &ARRAY(pArray); + if (array->length == 0) { + return NIL; + } + return array->data[--array->length]; +} + +Pointer array_set(Pointer pArray, size_t i, Pointer data) { + Array* array = &ARRAY(pArray); + if (array->size <= i) { + array->size = MAX(array->size * 2, 1); + while (array->size <= i) { + array->size = array->size * 2; + } + pArray = memory_resize(pArray, sizeof(Array) + array->size * sizeof(Pointer)); + array = &ARRAY(pArray); + while (array->length < i) { + array->data[array->length++] = UNDEFINED; + } + } + array->length++; + array->data[i] = data; + return pArray; +} + +Pointer array_get(Pointer pArray, size_t i) { + Array* array = &ARRAY(pArray); + if (array->length <= i) { + return UNDEFINED; + } + + return array->data[i]; +} + +size_t array_length(Pointer array) { + return ARRAY(array).length; +} diff --git a/implementations/c/src/cons.c b/implementations/c/src/cons.c new file mode 100644 index 0000000..f7fa251 --- /dev/null +++ b/implementations/c/src/cons.c @@ -0,0 +1,34 @@ +#include "lisp.h" + +Pointer cons(Pointer car, Pointer cdr) { + Pointer ptr = memory_new(CONS, sizeof(Cons)); + Cons* cons = &CONS(ptr); + cons->car = car; + cons->cdr = cdr; + return ptr; +} + + +Pointer reduce_fn(Pointer args, Pointer env) { + Pointer list = CAR(args); + Pointer reducer = CAR(CDR(args)); + Pointer previous = CAR(CDR(CDR(args))); + REDUCE(list, eval_fn(LIST(reducer, previous, CAR(list)), env), previous); + return previous; +} + +Pointer cons_fn(Pointer args) { + return cons(CAR(args), CAR(CDR(args))); +} + +Pointer car_fn(Pointer args) { + return CAR(CAR(args)); +} + +Pointer cdr_fn(Pointer args) { + return CDR(CAR(args)); +} + +Pointer list_fn(Pointer args) { + return args; +} diff --git a/implementations/c/src/environment.c b/implementations/c/src/environment.c new file mode 100644 index 0000000..07fa61b --- /dev/null +++ b/implementations/c/src/environment.c @@ -0,0 +1,32 @@ +#include "lisp.h" + +static Pointer GLOBALS; + +Pointer environment_get(Pointer env, Pointer key) { + while (env != NIL) { + Pointer value = table_get(CAR(env), key); + if (value != UNDEFINED) { + return value; + } + env = CDR(env); + } + + return table_get(GLOBALS, key); +} + +Pointer environment_set(Pointer env, Pointer key, Pointer value) { + while (env != NIL) { + if (table_get(CAR(env), key) != UNDEFINED) { + CONS(env).car = table_set(CAR(env), key, value); + return value; + } + env = CDR(env); + } + + GLOBALS = table_set(GLOBALS, key, value); + return key; +} + +void environment_init(void) { + GLOBALS = table(0); +} diff --git a/implementations/c/src/evaluator.c b/implementations/c/src/evaluator.c new file mode 100644 index 0000000..f146b35 --- /dev/null +++ b/implementations/c/src/evaluator.c @@ -0,0 +1,62 @@ +#include +#include "lisp.h" + +static Pointer run_fn(Func fn, Pointer params) { + Pointer body = CAR(fn.code); + Pointer args = CDR(fn.code); + Pointer env = fn.env; + Pointer value = NIL; + Pointer tbl = table(2); + + env = cons(tbl, env); + while(args != NIL && params != NIL) { + table_set(tbl, CAR(args), CAR(params)); + args = CDR(args); + params = CDR(params); + } + + REDUCE(body, eval_fn(body, env), value); + return value; +} + +Pointer eval(Pointer data, Pointer env) { + if (data == NIL) return NIL; + + switch(TYPE(data)) { + case CONS: { + Pointer op = eval(CAR(data), env); + Type type = TYPE(op); + data = CDR(data); + if (type == SPECIAL_FORM) { + return SPECIAL_FORM(op)(data, env); + } + + Pointer params = NIL; + if (data != NIL) { + Pointer* cdr = ¶ms; + while (data != NIL) { + *cdr = cons(eval(CAR(data), env), NIL); + cdr = &CONS(*cdr).cdr; + data = CDR(data); + } + *cdr = NIL; + } + + if (type == NATIVE_FUNC) { + return NATIVE_FUNC(op)(params); + } + + if (type == FUNC) { + return run_fn(FUNC(op), params); + } + printf("%s: %d\n", __FILE__, __LINE__); + return UNDEFINED; + } + case SYMBOL: return environment_get(env, data); + default: return data; + } +} + +Pointer eval_fn(Pointer args, Pointer env) { + return eval(CAR(args), env); +} diff --git a/implementations/c/src/evaluator.h b/implementations/c/src/evaluator.h new file mode 100644 index 0000000..00acb0d --- /dev/null +++ b/implementations/c/src/evaluator.h @@ -0,0 +1,7 @@ +#ifndef EVALUATOR_H +#define EVALUATOR_H +#include "types.h" +#include "memory.h" +Pointer evl_eval(Pointer data, Pointer env); +Pointer evl_runFn(Func fn, Pointer params); +#endif diff --git a/implementations/c/src/lisp.c b/implementations/c/src/lisp.c new file mode 100644 index 0000000..69ee377 --- /dev/null +++ b/implementations/c/src/lisp.c @@ -0,0 +1,305 @@ +#include +#include +#include +#include + +#include "lisp.h" + +/** CONSTRUCTORS **/ +Pointer number(Number num) { + Pointer ptr = memory_new(NUMBER, sizeof(Number)); + NUMBER(ptr) = num; + return ptr; +} + +Pointer native_func(NativeFunc func) { + Pointer ptr = memory_new(NATIVE_FUNC, sizeof(NativeFunc)); + NATIVE_FUNC(ptr) = func; + return ptr; +} + +Pointer special_form(SpecialForm func) { + Pointer ptr = memory_new(SPECIAL_FORM, sizeof(SpecialForm)); + SPECIAL_FORM(ptr) = func; + return ptr; +} + +Pointer func(Pointer code, Pointer env) { + Pointer fn = memory_new(FUNC, sizeof(Func)); + FUNC(fn).code = code; + FUNC(fn).env = env; + return fn; +} + +/** OPERATIONS **/ + +Pointer add_fn(Pointer args) { + Pointer result = number(0); + REDUCE(args, result; NUMBER(result) += NUMBER(CAR(args)), result); + return result; +} + +Pointer sub_fn(Pointer args) { + Pointer first = CAR(args); + Pointer rest = CDR(args); + if (first == NIL) return UNDEFINED; // Empty args + if (rest == NIL) return number(-NUMBER(first)); + Pointer result = number(NUMBER(first)); + REDUCE(rest, result; NUMBER(result) -= NUMBER(CAR(rest)), result); + return result; +} + +Pointer mul_fn(Pointer args) { + Pointer result = number(1); + REDUCE(args, result; NUMBER(result) *= NUMBER(CAR(args)), result); + return result; +} + +Pointer div_fn(Pointer args) { + Pointer first = CAR(args); + Pointer rest = CDR(args); + if (first == NIL) return UNDEFINED; // Empty args + if (rest == NIL) return number(1 / NUMBER(first)); + Pointer result = number(NUMBER(first)); + REDUCE(rest, result; NUMBER(result) /= NUMBER(CAR(rest)), result); + return result; +} + +Pointer pow_fn(Pointer args) { + Pointer a = CAR(args); + Pointer b = CAR(CDR(args)); + if (a == NIL || b == NIL) return UNDEFINED; // Arguments missing. + return number(pow(NUMBER(a), NUMBER(b))); +} + +Pointer sqrt_fn(Pointer args) { + Pointer a = CAR(args); + if (a == NIL) return UNDEFINED; // Arguments missing. + return number(sqrt(NUMBER(a))); +} + +Pointer logand_fn(Pointer args) { + Pointer result = number(-1l); + REDUCE(args, + result; NUMBER(result) = (long) NUMBER(result) & (long) NUMBER(CAR(args)), + result); + return result; +} + +Pointer logor_fn(Pointer args) { + Pointer result = number(0); + REDUCE(args, + result; NUMBER(result) = (long) NUMBER(result) | (long) NUMBER(CAR(args)), + result); + return result; +} + +Pointer logxor_fn(Pointer args) { + Pointer result = number(0); + REDUCE(args, + result; NUMBER(result) = (long) NUMBER(result) ^ (long) NUMBER(CAR(args)), + result); + return result; +} + +Pointer lognot_fn(Pointer args) { + Pointer a = CAR(args); + if (a == NIL) return UNDEFINED; // Arguments missing. + return number(~(long) NUMBER(a)); +} + +Pointer if_fn(Pointer args, Pointer env) { + if (eval_fn(args, env) != NIL) return eval_fn(CDR(args), env); + return eval_fn(CDR(CDR(args)), env); +} + +Pointer let_fn(Pointer args, Pointer env) { + Pointer alist = CAR(args); + Pointer body = CDR(args); + Pointer tbl = NIL; + Pointer keypair; + Pointer key; + Pointer value; + + if (alist != NIL) { + tbl = table(2); + env = cons(tbl, env); + do { + keypair = CAR(alist); + key = CAR(keypair); + value = eval_fn(CDR(keypair), env); + table_set(tbl, key, value); + alist = CDR(alist); + } while(alist != NIL); + } + + while(body != NIL) { + value = eval_fn(body, env); + body = CDR(body); + } + return value; +} + +Pointer quote_fn(Pointer args, Pointer env) { + (void) env; return CAR(args); +} + +Pointer and_fn(Pointer args, Pointer env) { + Pointer value = NIL; + while(args != NIL) { + value = eval_fn(args, env); + if (value == NIL) return NIL; + args = CDR(args); + } + return value; +} + +Pointer or_fn(Pointer args, Pointer env) { + Pointer value = NIL; + while(args != NIL) { + value = eval_fn(args, env); + if (value != NIL) return value; + args = CDR(args); + } + return NIL; +} + +Pointer not_fn(Pointer args) { + return CAR(args) == NIL ? T : NIL; +} + +Pointer def_fn(Pointer args, Pointer env) { + Pointer key = CAR(args); + Pointer value = eval_fn(CDR(args), env); + environment_set(NIL, key, value); + return key; +} + +Pointer set_fn(Pointer args, Pointer env) { + Pointer key = CAR(args); + Pointer value = eval_fn(CDR(args), env); + + environment_set(env, key, value); + return value; +} + +Pointer fn_fn(Pointer args, Pointer env) { + return func(args, env); +} + +void init(void) { + memory_init(16); + symbol_init(); + reader_init(); + environment_init(); + environment_set(NIL, STANDARD_INPUT, stream(stdin)); + environment_set(NIL, STANDARD_OUTPUT, stream(stdout)); + Pointer add = symbol1("+"); + environment_set(NIL, add, native_func(add_fn)); +} + +void repl(void) { + Pointer readed = read_fn(NIL, NIL); + print(eval(readed, NIL), stdout); + printf("\n"); +} + +/* Pointer op_readChar(Pointer params) { */ +/* return readerPop(params == NIL ? STANDARD_INPUT : GET_CONS(params).car); */ +/* } */ + +/* Pointer op_peekChar(Pointer params) { */ +/* return readerPop(params == NIL ? STANDARD_INPUT : GET_CONS(params).car); */ +/* } */ + +/* Pointer set_reader_macro(Pointer params) { */ +/* Cons cons = CONS(params); */ +/* return rdr_setReaderMacro(cons.car, GET_CONS(cons.cdr).car); */ +/* } */ + +/* Pointer op_read(Pointer params) { */ +/* return rdr_read(CAR(params)); */ +/* } */ + +/* Pointer op_map(Pointer params) { */ +/* Cons cons = GET_CONS(params); */ +/* Pointer list = cons.car; */ +/* Pointer fn = GET_CONS(cons.cdr).car; */ +/* while (list != NIL) { */ +/* cons = GET_CONS(list); */ +/* list = cons.cdr; */ +/* } */ +/* } */ + +/* void run() { */ +/* do { */ +/* prn_print(evl_eval(rdr_read(GLOBAL_ENV_GET(STANDARD_INPUT)), */ +/* ALLOC_CONS(GLOBAL_ENV, NIL)), */ +/* stdout); */ +/* fprintf(stdout, "\n"); */ +/* } while(rdr_peekChar(T, GET_STREAM(GLOBAL_ENV_GET(STANDARD_INPUT))) != 0); */ +/* } */ + +/* void start() { */ +/* mem_init(1024); */ +/* ascii_init(); */ +/* GLOBAL_ENV = tbl_alloc(2); // GLOBAL ENV */ + +/* ALLOC_STATIC_SYMBOL(NIL, "nil"); */ +/* ALLOC_STATIC_SYMBOL(T, "t"); */ +/* ALLOC_STATIC_SYMBOL(STANDARD_INPUT, "*standard-input*"); */ +/* ALLOC_STATIC_SYMBOL(STANDARD_OUTPUT, "*standard-output*"); */ +/* ALLOC_STATIC_SYMBOL(READTABLE, "*readtable*"); */ +/* ALLOC_NATIVE_FUNC("+", op_add); */ +/* ALLOC_NATIVE_FUNC("-", op_sub); */ +/* ALLOC_NATIVE_FUNC("*", op_mul); */ +/* ALLOC_NATIVE_FUNC("/", op_div); */ +/* ALLOC_NATIVE_FUNC("pow", op_pow); */ +/* ALLOC_NATIVE_FUNC("sqrt", op_sqrt); */ +/* ALLOC_NATIVE_FUNC("&", op_logand); */ +/* ALLOC_NATIVE_FUNC("|", op_logior); */ +/* ALLOC_NATIVE_FUNC("^", op_logxor); */ +/* ALLOC_NATIVE_FUNC("~", op_lognot); */ +/* ALLOC_NATIVE_FUNC("list", op_list); */ +/* ALLOC_NATIVE_FUNC("car", op_car); */ +/* ALLOC_NATIVE_FUNC("cdr", op_cdr); */ +/* ALLOC_NATIVE_FUNC("not", op_not); */ +/* ALLOC_NATIVE_FUNC("set-reader-macro", op_setReaderMacro); */ +/* ALLOC_NATIVE_FUNC("read", op_read); */ +/* ALLOC_SPECIAL_FORM("if", op_if); */ +/* ALLOC_SPECIAL_FORM("let", op_let); */ +/* ALLOC_SPECIAL_FORM("quote", op_quote); */ +/* ALLOC_SPECIAL_FORM("and", op_and); */ +/* ALLOC_SPECIAL_FORM("or", op_or); */ +/* ALLOC_SPECIAL_FORM("def", op_def); */ +/* ALLOC_SPECIAL_FORM("set", op_set); */ +/* ALLOC_SPECIAL_FORM("fn", op_fn); */ +/* /\* ALLOC_STREAM(STANDARD_INPUT, "*standard-input*", stdin); *\/ */ +/* /\* ALLOC_STREAM(STANDARD_OUTPUT, "*standard-output*", stdout); *\/ */ + +/* rdr_init(); */ +/* /\* op_print(getFromTable(globalEnv, T), stdout); *\/ */ +/* /\* op_print(globalEnv, stdout); *\/ */ + + +/* /\* Stream stream = {"(fn (stream char) ())\0"}; *\/ */ +/* /\* tbl_insert(readerMacros, *\/ */ +/* /\* '\\', *\/ */ +/* /\* mem_alloc(CONS, *\/ */ +/* /\* (Data) (Cons) {eval(read(&stream), NIL), NIL})); *\/ */ + + +/* /\* inputStream.text = "(def add (fn (a b) (+ a b))) (add 1 2)\0"; *\/ */ +/* /\* inputStream.text = "(if t 1 2)\0"; *\/ */ +/* /\* printf("%s\n", inputStream.text); *\/ */ + +/* FILE* file = fopen("lisp.lisp", "r"); */ +/* GLOBAL_ENV_INSERT(STANDARD_INPUT, ALLOC_STREAM(file)); */ +/* run(); */ +/* fclose(file); */ + +/* GLOBAL_ENV_SET(STANDARD_INPUT, ALLOC_STREAM(stdin)); */ +/* run(); */ +/* printf("\n"); */ +/* } */ + diff --git a/implementations/c/src/lisp.h b/implementations/c/src/lisp.h new file mode 100644 index 0000000..8412fad --- /dev/null +++ b/implementations/c/src/lisp.h @@ -0,0 +1,257 @@ +#ifndef LISP_H +#define LISP_H +#include +#include +#include + +typedef enum { + CHAR, // 0 + SYMBOL, // 1 + NUMBER, // 2 + NATIVE_FUNC, // 3 + SPECIAL_FORM, // 4 + STREAM, // 5 + FUNC, // 6 + STRING, // 7 + TABLE, // 8 + ARRAY, // 9 + CONS, // 10 + ERROR, // 11 + TYPE_ALL // 12 +} Type; + +typedef unsigned Pointer; +typedef unsigned Char; + +typedef struct { + Pointer car, cdr; +} Cons; + +typedef double Number; + +typedef struct { + unsigned length; + char data[]; +} Symbol; + +typedef struct { + unsigned length; + char data[]; +} String; + +typedef struct { + unsigned length; + char data[]; +} Error; + +typedef struct { + unsigned length, size; + Pointer data[]; +} Array; + +typedef struct { + /* Pointer args; */ + /* Pointer body; */ + Pointer code, env; +} Func; + +typedef struct { + unsigned offset, length; +} TableHash; + +typedef struct { + Pointer key, value; +} TablePair; + +typedef union { + TableHash hash; + TablePair pair; +} TableData; + +typedef struct { + unsigned length, size; + TableData data[]; +} Table; + +/* CHANGER POUR TABLEAU DE FONCTIONS */ +typedef Pointer (*NativeFunc)(Pointer params); +typedef Pointer (*SpecialForm)(Pointer params, Pointer env); + +/* FIN A RETRAVAILLER! */ + +typedef FILE* Stream; + +typedef union { + Cons cons; + Symbol symbol; + Number number; + Table table; + NativeFunc nativeFunc; + SpecialForm specialForm; + Func func; + String string; + Stream stream; + Array array; + Char c; + Error error; + Pointer next; +} Data; + +typedef struct { + /* Header header; */ + Type type: 4; + bool garbage: 1; + size_t size: sizeof(size_t) * 8 - 5; + Data data[]; +} Block; // 16 Bytes + +typedef struct Memory { + Block* buffer; + Pointer freelist; + size_t used, size; // Actual bytes +} Memory; + +extern Pointer NIL; +extern Pointer UNDEFINED; +extern Pointer T; +extern Pointer STANDARD_INPUT; +extern Pointer STANDARD_OUTPUT; + +/** UTILS **/ +void init(void); +void memory_init(size_t); +void symbol_init(void); +void reader_init(void); +void environment_init(void); + +void memory_free(void); +Block* memory_get(Pointer); +Pointer memory_new(Type, size_t); +void memory_destroy(Pointer); +Pointer memory_resize(Pointer, size_t); + +void repl(void); + +Pointer array_push(Pointer, Pointer); +Pointer array_pop(Pointer); +Pointer array_set(Pointer, size_t, Pointer); +Pointer array_get(Pointer, size_t); +size_t array_length(Pointer); + +Pointer table_get(Pointer, Pointer); +Pointer table_set(Pointer, Pointer, Pointer); + +Pointer string_push(Pointer str, char c); +Pointer string_clear(Pointer str); + +Pointer environment_get(Pointer env, Pointer key); +Pointer environment_set(Pointer env, Pointer key, Pointer value); + +Pointer set_reader_macro(Pointer c, Pointer fn); +Char get_utf8(FILE* s); +Char unget_utf8(Char c, FILE* s); +Char peek_char(Pointer type, Stream stream); + +Pointer prin1(Pointer data, Stream stream); +Pointer print(Pointer data, Stream stream); + +Pointer eval(Pointer data, Pointer env); + + +/* CONSTRUCTORS */ +Pointer array(size_t size); +Pointer table(size_t size); +Pointer symbol(char* string, size_t size); +#define symbol1(s) symbol(s, sizeof(s) - 1) +Pointer string(char* string, size_t size); +Pointer cons(Pointer car, Pointer cdr); +Pointer number(Number num); +Pointer func(Pointer code, Pointer env); +Pointer native_func(NativeFunc func); +Pointer special_form(SpecialForm func); +Pointer character(Char c); +Pointer stream(FILE* s); + +/* OPERATIONS */ +Pointer eval_fn(Pointer args, Pointer env); +Pointer cons_fn(Pointer args); +Pointer car_fn(Pointer args); +Pointer cdr_fn(Pointer args); +Pointer reduce_fn(Pointer args, Pointer env); +Pointer add_fn(Pointer args); +Pointer list_fn(Pointer args); +Pointer sub_fn(Pointer args); +Pointer mul_fn(Pointer args); +Pointer div_fn(Pointer args); +Pointer pow_fn(Pointer args); +Pointer sqrt_fn(Pointer args); +Pointer logand_fn(Pointer args); +Pointer logor_fn(Pointer args); +Pointer logxor_fn(Pointer args); +Pointer lognot_fn(Pointer args); +Pointer if_fn(Pointer args, Pointer env); +Pointer let_fn(Pointer args, Pointer env); +Pointer quote_fn(Pointer args, Pointer env); +Pointer and_fn(Pointer args, Pointer env); +Pointer or_fn(Pointer args, Pointer env); +Pointer not_fn(Pointer args); +Pointer def_fn(Pointer args, Pointer env); +Pointer set_fn(Pointer args, Pointer env); +Pointer fn_fn(Pointer args, Pointer env); +Pointer peek_char_fn(Pointer args, Pointer env); +Pointer read_char_fn(Pointer args, Pointer env); +Pointer read_fn(Pointer args, Pointer env); +Pointer set_reader_macro_fn(Pointer args); +Pointer read_char_macro_fn(Pointer args, Pointer env); +Pointer read_list_macro_fn(Pointer args, Pointer env); +Pointer read_right_paren_macro_fn(Pointer args, Pointer env); +Pointer print_fn(Pointer args, Pointer env); + +#define TYPE(p) memory_get(p)->type +#define SIZE(p) memory_get(p)->size +#define GET(p) memory_get(p)->data +#define NEXT(p) GET(p)->next +#define CONS(p) GET(p)->cons +#define NUMBER(p) GET(p)->number +#define SYMBOL(p) GET(p)->symbol +#define STRING(p) GET(p)->string +#define CHAR(p) GET(p)->c +#define ARRAY(p) GET(p)->array +#define TABLE(p) GET(p)->table +#define SPECIAL_FORM(p) GET(p)->specialForm +#define NATIVE_FUNC(p) GET(p)->nativeFunc +#define FUNC(p) GET(p)->func +#define STREAM(p) GET(p)->stream + +#define CAR(p) (p == NIL ? NIL : CONS(p).car) +#define CDR(p) (p == NIL ? NIL : CONS(p).cdr) + +#define ELEVENTH_ARGUMENT(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, ...) a11 +#define COUNT_ARGUMENTS(...) ELEVENTH_ARGUMENT(dummy, ## __VA_ARGS__, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0) +/* #define LIST(...) list_new(COUNT_ARGUMENTS(__VA_ARGS__), __VA_ARGS__) */ + +#define LIST_0 NIL +#define LIST_1(a) cons(a, LIST_0) +#define LIST_2(a, ...) cons(a, LIST_1(__VA_ARGS__)) +#define LIST_3(a, ...) cons(a, LIST_2(__VA_ARGS__)) +#define LIST_4(a, ...) cons(a, LIST_3(__VA_ARGS__)) +#define LIST_5(a, ...) cons(a, LIST_4(__VA_ARGS__)) +#define LIST_6(a, ...) cons(a, LIST_5(__VA_ARGS__)) +#define LIST_7(a, ...) cons(a, LIST_6(__VA_ARGS__)) +#define LIST_8(a, ...) cons(a, LIST_7(__VA_ARGS__)) +#define LIST_9(a, ...) cons(a, LIST_8(__VA_ARGS__)) + +#define LIST__(n, ...) LIST_##n(__VA_ARGS__) +#define LIST_(n, ...) LIST__(n, __VA_ARGS__) +#define LIST(...) LIST_(COUNT_ARGUMENTS(__VA_ARGS__), __VA_ARGS__) + +#define REDUCE(list, reducer, previous) \ + while(list != NIL) { \ + previous = reducer; \ + list = CDR(list); \ + } + +#define MIN(X, Y) (((X) < (Y)) ? (X) : (Y)) +#define MAX(X, Y) (((X) > (Y)) ? (X) : (Y)) + +#endif diff --git a/implementations/c/src/macros.h b/implementations/c/src/macros.h new file mode 100644 index 0000000..c9ba252 --- /dev/null +++ b/implementations/c/src/macros.h @@ -0,0 +1,18 @@ +#ifndef MACROS_H +#define MACROS_H + +#define CONS(p) (mem_get(p)->data->cons) +#define NUMBER(p) (mem_get(p)->data->number) +#define SYMBOL(p) (mem_get(p)->data->symbol) +#define TABLE(p) (mem_get(p)->data->table) +#define TABLE_PAIR(p) (mem_get(p)->data->tablePair) +#define SPECIAL_FORM(p) (mem_get(p)->data->specialForm) +#define NATIVE_FUNC(p) (mem_get(p)->data->nativeFunc) +#define FUNC(p) (mem_get(p)->data->func) +#define STREAM(p) (mem_get(p)->data->stream) + + +#define GLOBAL_ENV_GET(key) tbl_get(GLOBAL_ENV, key) +#define GLOBAL_ENV_SET(key, value) tbl_set(GLOBAL_ENV, key, value) + +#endif diff --git a/implementations/c/src/main.c b/implementations/c/src/main.c new file mode 100644 index 0000000..175fecf --- /dev/null +++ b/implementations/c/src/main.c @@ -0,0 +1,10 @@ +#include "lisp.h" +#include +#include + +int main() { + printf(">>> "); + init(); + repl(); + return 0; +} diff --git a/implementations/c/src/memory.c b/implementations/c/src/memory.c new file mode 100644 index 0000000..40be502 --- /dev/null +++ b/implementations/c/src/memory.c @@ -0,0 +1,329 @@ +#include +#include +#include +#include +#include "lisp.h" +#include + +static Memory MEMORY; + +static size_t alignToPow2(size_t n) { + return pow(2, ceil(log2(n))); +} + +static size_t alignToBlock(size_t n) { + return alignToPow2(MAX(((n + sizeof(Block) - 1) / sizeof(Block)) + 1, 2)); +} + +void memory_init(size_t size) { + MEMORY.used = 0; + MEMORY.size = alignToPow2(MAX(size, 2)); + MEMORY.buffer = malloc(MEMORY.size * sizeof(Block)); + MEMORY.freelist = 0; + MEMORY.buffer[MEMORY.freelist] = (Block) { + .garbage = true, + .size = MEMORY.size, + }; + MEMORY.buffer[MEMORY.freelist].data->next = -1u; +} + +void memory_free(void) { + free(MEMORY.buffer); +} + +Block* memory_get(Pointer data) { + assert(data < MEMORY.size); + return &MEMORY.buffer[data]; +} + +static void iterate_freelist(size_t free_size, + Pointer* free, + Block** free_previous, + bool free_break, + Pointer after_start, + size_t after_size, + Pointer* after, + Block** after_previous, + bool after_break, + Pointer* last, + Block** last_previous) { + Pointer freelist = MEMORY.freelist; + Block* previous = NULL; + Block* block = NULL; + while (freelist != -1u) { + block = memory_get(freelist); + if (block->size >= free_size) { + if (free) *free = freelist; + if (free_previous) *free_previous = previous; + if (free_break) break; + } + + if (freelist + block->size == MEMORY.size) { + if (last) *last = freelist; + if (last_previous) *last_previous = previous; + } + + if (freelist == after_start && + block->size >= after_size) { + if (after) *after = freelist; + if (after_previous) *after_previous = previous; + if (after_break) break; + } + + previous = block; + freelist = block->data->next; + } +} + +static Pointer use_free_slot(Type type, size_t size, Pointer free, Block* previous) { + Block* block = memory_get(free); + if (block->size == size) { + if (previous != NULL) { + previous->data->next = block->data->next; + } else { + MEMORY.freelist = block->data->next; + } + + block->type = type; + block->garbage = false; + return free; + } + + size_t offset = size; + size_t idx = free + offset; + Block* new = block + offset; + new->data->next = block->data->next; + new->size = block->size - size; + new->garbage = true; + + if (previous != NULL) { + previous->data->next = idx; + } else { + MEMORY.freelist = idx; + } + + block->type = type; + block->garbage = false; + block->size = size; + + return free; +} + +Pointer alloc_free_slot(Type type, size_t size, Pointer last, Block* last_previous) { + // Memory_Get last free slot in buffer + Pointer freelist = last; + size_t requiredSize = MEMORY.size; + if (last == -1u) { + freelist = MEMORY.size; + requiredSize += size; + } else { + if (last_previous != NULL) { + last_previous->data->next = NEXT(last); + } else { + MEMORY.freelist = NEXT(last); + } + + requiredSize += size - SIZE(last); + } + + while (MEMORY.size < requiredSize) { + MEMORY.size *= 2; + } + MEMORY.buffer = realloc(MEMORY.buffer, MEMORY.size * sizeof(Block)); + + Block* block = memory_get(freelist); + block->type = type; + block->garbage = false; + block->size = size; + + if (freelist + size < MEMORY.size) { + block += size; + block->size = MEMORY.size - freelist - size; + block->garbage = true; + block->data->next = MEMORY.freelist; + MEMORY.freelist = freelist + size; + } else { + MEMORY.freelist = -1u; + } + + return freelist; +} + +Pointer memory_new(Type type, size_t size) { + /* if (size == 0) { */ + /* return -1u; // Why alloc an element of zero size? */ + /* } */ + + size = alignToBlock(size); + + Pointer free = -1u; + Block* free_previous = NULL; + Pointer last = -1u; + Block* last_previous = NULL; + iterate_freelist(size, + &free, + &free_previous, + true, + 0, + 0, + NULL, + NULL, + false, + &last, + &last_previous); + + if (free != -1u) { + return use_free_slot(type, size, free, free_previous); + } + + /* return alloc_free_slot(type, size, last, last_previous); */ + return alloc_free_slot(type, size, last, last_previous); +} + +void memory_destroy(Pointer ptr) { + Block* block = memory_get(ptr); + Block* last = NULL; + Block* beforeNext = NULL; + + Pointer freelist = MEMORY.freelist; + Pointer previous = -1u; + Pointer next = -1u; + while (freelist != -1u && + (previous == -1u || next == -1u)) { + Block* free = memory_get(freelist); + if (freelist + free->size == ptr) { + previous = freelist; + } + + if (freelist == ptr + block->size) { + next = freelist; + beforeNext = last; + } + last = free; + freelist = free->data->next; + } + + if (next != -1u) { + Block* nblk = memory_get(next); + block->size += nblk->size; + if (beforeNext != NULL) { + last->data->next = nblk->data->next; + } else { + MEMORY.freelist = nblk->data->next; + } + } + + if (previous != -1u) { + Block* pblk = memory_get(previous); + pblk->size += block->size; + } else { + block->data->next = MEMORY.freelist; + MEMORY.freelist = ptr; + } +} + +Pointer memory_resize(Pointer ptr, size_t new_size) { + Block* pblock = memory_get(ptr); + Block* block; + size_t prev_size = pblock->size; + new_size = MAX(alignToBlock(new_size), 2); + + size_t remaining = new_size - prev_size; + + if (new_size == prev_size) { + return ptr; + } + + if (new_size < prev_size) { + // Shrink + Pointer rest = ptr + new_size; + block = memory_get(rest); + block->size = prev_size - new_size; + block->data->next = MEMORY.freelist; + block->garbage = true; + MEMORY.freelist = rest; + pblock->size = new_size; + return ptr; + } + + Pointer free = -1u; + Block* free_previous = NULL; + Pointer after = -1u; + Block* after_previous = NULL; + Pointer last = -1u; + Block* last_previous = NULL; + iterate_freelist(new_size, + &free, + &free_previous, + false, + ptr + prev_size, + remaining, + &after, + &after_previous, + true, + &last, + &last_previous); + + if (after != -1u) { + block = memory_get(after); + if (block->size > remaining) { + Pointer restPtr = after + remaining; + Block* rest = memory_get(restPtr); + rest->size = block->size - remaining; + NEXT(restPtr) = NEXT(after); + if (after_previous != NULL) { + after_previous->data->next = restPtr; + } else { + MEMORY.freelist = restPtr; + } + } else { + if (after_previous != NULL) { + after_previous->data->next = block->data->next; + } else { + MEMORY.freelist = block->data->next; + } + } + block->garbage = false; + pblock->size = new_size; + return ptr; + } + + + if (free != -1u || + (ptr + pblock->size != last && + ptr + pblock->size != MEMORY.size)) { + if (free == -1u) { + free = alloc_free_slot(pblock->type, new_size, last, last_previous); + } else { + free = use_free_slot(pblock->type, new_size, free, free_previous); + } + + Pointer offset = free - ptr; + for (size_t i = 0; i < MEMORY.size; ) { + block = memory_get(i); + switch (block->type) { + case CONS: + if (CONS(i).car == ptr) CONS(i).car += offset; + if (CONS(i).cdr == ptr) CONS(i).cdr += offset; + break; + case TABLE: // TODO: handle for Table + case ARRAY: // TODO: handle for Vector + default: break; + } + i += block->size; + } + + // Copy old memory to new memory + for (size_t i = 1; i <= prev_size; i++) { + MEMORY.buffer[free + i] = MEMORY.buffer[ptr + i]; + } + + // Free old memory + memory_destroy(ptr); + + return free; + } + + alloc_free_slot(pblock->type, remaining, last, last_previous); + return ptr; +} diff --git a/implementations/c/src/printer.c b/implementations/c/src/printer.c new file mode 100644 index 0000000..18b6eba --- /dev/null +++ b/implementations/c/src/printer.c @@ -0,0 +1,68 @@ +#include "lisp.h" + +Pointer prin1(Pointer data, Stream stream) { + switch (TYPE(data)) { + case CONS: + fprintf(stream, "("); + prin1(CAR(data), stream); + while((data = CDR(data)) != NIL) { + fprintf(stream, " "); + prin1(CAR(data), stream); + } + fprintf(stream, ")"); + break; + case NUMBER: fprintf(stream, "%g", NUMBER(data)); break; + case TABLE: { + Table* table = &TABLE(data); + fprintf(stream, "{"); + int num = 0; + for (unsigned i = 0; i < table->size; i++) { + TableHash hash = table->data[i].hash; + for (unsigned j = 0; j < hash.length; j++) { + TablePair pair = table->data[table->size + hash.offset + j].pair; + if (num++ > 0) { + fprintf(stream, ", "); + } + prin1(pair.key, stream); + fprintf(stream, ": "); + prin1(pair.value, stream); + } + } + fprintf(stream, "}"); + } + break; + case NATIVE_FUNC: fprintf(stream, "NATIVE_FUNC"); break; + case SPECIAL_FORM: fprintf(stream, "SPECIAL_FORM"); break; + case FUNC: + prin1(LIST(symbol("fn", sizeof("fn")), FUNC(data).code), stream); + break; + case SYMBOL: fprintf(stream, "%.*s", SYMBOL(data).length, SYMBOL(data).data); break; + case STRING: fprintf(stream, "%.*s", STRING(data).length, STRING(data).data); break; + case CHAR: fprintf(stream, "\\%1.4s", (char*) &CHAR(data)); break; + default: + fprintf(stream, + "[MISSING PRINT type: %d, pointer: %d]", + TYPE(data), + data); + break; + } + + return data; +} + +Pointer print(Pointer data, Stream stream) { + fprintf(stream, "\n"); + prin1(data, stream); + fprintf(stream, " "); + fflush(stream); + return data; +} + +Pointer print_fn(Pointer args, Pointer env) { + Pointer data = CAR(args); + Pointer streamPtr = CAR(CDR(args)); + Stream stream = streamPtr == NIL + ? STREAM(environment_get(env, STANDARD_OUTPUT)) + : STREAM(streamPtr); + return print(data, stream); +} diff --git a/implementations/c/src/printer.h b/implementations/c/src/printer.h new file mode 100644 index 0000000..ee3a4b7 --- /dev/null +++ b/implementations/c/src/printer.h @@ -0,0 +1,6 @@ +#ifndef PRINTER_H +#define PRINTER_H +#include +#include "types.h" +Pointer prn_print(Pointer data, FILE* stream); +#endif diff --git a/implementations/c/src/reader.c b/implementations/c/src/reader.c new file mode 100644 index 0000000..9937ee0 --- /dev/null +++ b/implementations/c/src/reader.c @@ -0,0 +1,263 @@ +#include +#include +#include "lisp.h" + +static Pointer READTABLE; + +Pointer character(Char c) { + Pointer ptr = memory_new(CHAR, sizeof(Char)); + CHAR(ptr) = c; + return ptr; +} + +unsigned get_utf8(FILE* s) { + unsigned c = getc(s); + if (c & 0x80 && c & 0x40) { + switch(c >> 3 & 0x07) { + case 0: + case 1: + case 2: + case 3: + c |= getc(s) << 8; + break; + case 4: + case 5: + c |= getc(s) << 8; + c |= getc(s) << 16; + break; + case 6: + c |= getc(s) << 8; + c |= getc(s) << 16; + c |= getc(s) << 24; + break; + default: break; + } + } + return c; +} + +unsigned unget_utf8(unsigned c, FILE* s) { + switch (c & 0x80808000) { + case 0x80808000: ungetc(c >> 24, s); + case 0x00808000: ungetc(c >> 16, s); + case 0x00008000: ungetc(c >> 8, s); + } + ungetc(c, s); + return c; +} + +Pointer stream(FILE* s) { + Pointer ptr = memory_new(STREAM, sizeof(Stream)); + STREAM(ptr) = s; + return ptr; +} + +Char peek_char(Pointer type, Stream stream) { + Char c; + if (feof(stream)) return 0; + if (type == NIL) { + return unget_utf8(get_utf8(stream), stream); + } + if (type == T) { + while(!feof(stream) && (c = get_utf8(stream)) == ' '); + if (feof(stream)) return 0; + return unget_utf8(c, stream); + } + if (TYPE(type) == CHAR) { + while(!feof(stream) && (c = get_utf8(stream)) != CHAR(type)); + if (feof(stream)) return 0; + return unget_utf8(c, stream); + } + + return UNDEFINED; +} + +Pointer peek_char_fn(Pointer args, Pointer env) { + Pointer type = CAR(args); + Pointer streamPtr = CAR(CDR(args)); + Stream stream = streamPtr == NIL + ? STREAM(environment_get(env, STANDARD_INPUT)) + : STREAM(streamPtr); + + Char c = peek_char(type, stream); + if (feof(stream)) { + return NIL; + } + + return character(c); +} + +Pointer read_char_fn(Pointer args, Pointer env) { + Pointer streamPtr = CAR(args); + Stream stream = streamPtr == NIL + ? STREAM(environment_get(env, STANDARD_INPUT)) + : STREAM(streamPtr); + if (feof(stream)) { + return NIL; + } + + return character(get_utf8(stream)); +} + +static Pointer buffer; +Pointer read_fn(Pointer args, Pointer env) { + Pointer streamPtr = CAR(args); + Stream stream = streamPtr == NIL + ? STREAM(environment_get(env, STANDARD_INPUT)) + : STREAM(streamPtr); + double num = 0; + Pointer macro; + int pos; + Char c = peek_char(T, stream); + if (feof(stream)) return NIL; + + macro = table_get(READTABLE, c); + if (macro != UNDEFINED) { + switch(memory_get(macro)->type) { + case SPECIAL_FORM: + return SPECIAL_FORM(macro)(LIST(streamPtr, character(get_utf8(stream))), env); + case FUNC: + return eval_fn(LIST(macro, streamPtr, character(get_utf8(stream))), env); + default: break; + } + } + + string_clear(buffer); + while ((c = peek_char(NIL, stream)) != 0 && + !isspace((char) c) && + table_get(READTABLE, c) == UNDEFINED) { + buffer = string_push(buffer, getc(stream)); + } + buffer = string_push(buffer, '\0'); + + char* end; + num = strtod(STRING(buffer).data, &end); + if ((size_t) end == (size_t) STRING(buffer).data + STRING(buffer).length - 1) { + return number(num); + } + + return symbol(STRING(buffer).data, STRING(buffer).length - 1); +} + +Pointer set_reader_macro(Pointer c, Pointer fn) { + READTABLE = table_set(READTABLE, c, fn); + return T; +} + +Pointer set_reader_macro_fn(Pointer args) { + return set_reader_macro(CAR(args), CAR(CDR (args))); +} + +static bool return_char(Stream stream) { + Char c; + return feof(stream) || + (c = peek_char(NIL, stream)) == 0 || + isspace((char) c) || + table_get(READTABLE, c) != UNDEFINED; +} + +static char space[] = "SPACE"; +static char tab[] = "TAB"; +static char newline[] = "NEWLINE"; + +Pointer read_char_macro_fn(Pointer args, Pointer env) { + (void) env; + Pointer streamPtr = CAR(args); + Stream stream = streamPtr == NIL + ? STREAM(environment_get(env, STANDARD_INPUT)) + : STREAM(streamPtr); + Char c = get_utf8(stream); + + if (return_char(stream)) { + return character(c); + } + + int pos = 0; + char searched_char = 0; + c = toupper(c); + if (c == (unsigned) space[pos]) { + pos++; + searched_char = ' '; + } else if (c == (unsigned) tab[pos]) { + pos++; + searched_char = '\t'; + } else if (c == (unsigned) newline[pos]) { + pos++; + searched_char = '\n'; + } + + while (!feof(stream) && + (c = get_utf8(stream)) && + !isspace((char) c) && + table_get(READTABLE, c) == UNDEFINED && + searched_char != 0) { + c = toupper(c); + switch (searched_char) { + case ' ': + if (c == (unsigned) space[pos]) { + if (pos == sizeof(space) - 2 && return_char(stream)) { + return character(' '); + } + pos++; + continue; + } + break; + case '\t': + if (c == (unsigned) tab[pos]) { + if (pos == sizeof(tab) - 2 && return_char(stream)) { + return character('\t'); + } + pos++; + continue; + } + break; + case '\n': + if (c == (unsigned) newline[pos]) { + if (pos == sizeof(newline) - 2 && return_char(stream)) { + return character('\n'); + } + pos++; + continue; + } + } + break; + } + + return UNDEFINED; // ERROR! +} + +Pointer read_list_macro_fn(Pointer args, Pointer env) { + Pointer streamPtr = CAR(args); + Stream stream = streamPtr == NIL + ? STREAM(environment_get(env, STANDARD_INPUT)) + : STREAM(streamPtr); + Pointer car = read_fn(args, env); + Pointer cdr = NIL; + char c = peek_char(T, stream); + + if (!feof(stream)) { + if (c != ')') { + cdr = read_list_macro_fn(args, env); + } else { + get_utf8(stream); + } + } + + return cons(car, cdr); +} + +Pointer read_right_paren_macro_fn(Pointer args, Pointer env) { + (void) args; (void) env; + return NIL; // TODO: Should return an error when the error system is set. +} + +void reader_init(void) { + buffer = string(NULL, 0); + READTABLE = table(1); + READTABLE = table_set(READTABLE, '(', special_form(read_list_macro_fn)); + READTABLE = table_set(READTABLE, ')', special_form(read_list_macro_fn)); + READTABLE = table_set(READTABLE, '\\', special_form(read_char_macro_fn)); + /* GLOBALS = table_set(GLOBALS, */ + /* symbol("*standard-input*", sizeof("*standard-input*")), */ + /* stream(stdin)); */ +} diff --git a/implementations/c/src/reader.h b/implementations/c/src/reader.h new file mode 100644 index 0000000..f2a92e6 --- /dev/null +++ b/implementations/c/src/reader.h @@ -0,0 +1,9 @@ +#ifndef READER_H +#define READER_H +#include "types.h" +void rdr_init(); +Pointer rdr_peek_char(Pointer type, Stream stream); +Pointer rdr_read_char(Stream stream); +Pointer rdr_read(Pointer params); +Pointer rdr_set_reader_macro(Pointer c, Pointer fn); +#endif diff --git a/implementations/c/src/string.c b/implementations/c/src/string.c new file mode 100644 index 0000000..733a280 --- /dev/null +++ b/implementations/c/src/string.c @@ -0,0 +1,25 @@ +#include "lisp.h" + +Pointer string(char* string, size_t length) { + Pointer pointer = memory_new(STRING, sizeof(String) + length); + String* str = &STRING(pointer); + str->length = length; + for (unsigned i = 0; i < length; i++) { + str->data[i] = string[i]; + } + + return pointer; +} + +Pointer string_push(Pointer pointer, char c) { + pointer = memory_resize(pointer, sizeof(String) + STRING(pointer).length + 1); + String* string = &STRING(pointer); + string->data[string->length++] = c; + return pointer; +} + +Pointer string_clear(Pointer str) { + STRING(str).length = 0; + return str; +} + diff --git a/implementations/c/src/symbol.c b/implementations/c/src/symbol.c new file mode 100644 index 0000000..2b46623 --- /dev/null +++ b/implementations/c/src/symbol.c @@ -0,0 +1,57 @@ +#include +#include "lisp.h" + +Pointer NIL; +Pointer T; +Pointer STANDARD_INPUT; +Pointer STANDARD_OUTPUT; +Pointer UNDEFINED; + +static Pointer SYMBOLS; + +Pointer symbol(char* string, size_t length) { + Symbol* symbol; + bool matching = false; + Pointer pointer = -1; + + Array* symbols = &ARRAY(SYMBOLS); + for (size_t i = 0; i < symbols->length; i++) { + pointer = array_get(SYMBOLS, i); + symbol = &SYMBOL(pointer); + if (symbol->length != length) { + continue; + } + + matching = true; + for (unsigned j = 0; j < length; j++) { + if (symbol->data[j] != string[j]) { + matching = false; + break; + } + } + + if (matching) { + return pointer; + } + } + + pointer = memory_new(SYMBOL, sizeof(Symbol) + length); + SYMBOLS = array_push(SYMBOLS, pointer); + symbol = &SYMBOL(pointer); + symbol->length = length; + for (unsigned i = 0; i < length; i++) { + symbol->data[i] = string[i]; + } + + return pointer; +} + +void symbol_init(void) { + SYMBOLS = array(2); + NIL = symbol1("nil"); + T = symbol1("t"); + STANDARD_INPUT = symbol1("*standard-input*"); + STANDARD_OUTPUT = symbol1("*standard-output*"); + UNDEFINED = symbol1("undefined"); +} + diff --git a/implementations/c/src/table.c b/implementations/c/src/table.c new file mode 100644 index 0000000..44741cb --- /dev/null +++ b/implementations/c/src/table.c @@ -0,0 +1,97 @@ +#include +#include "lisp.h" + +Pointer table(size_t size) { + size = pow(2, ceil(log2(size))); + Pointer pointer = memory_new(TABLE, sizeof(Table) + size * sizeof(TableData) * 2); + Table* tbl = &TABLE(pointer); + tbl->length = 0; + tbl->size = size; + + for (unsigned i = 0; i < size; i++) { + tbl->data[i].hash = (TableHash) {0, 0}; + } + + return pointer; +} + +Pointer table_get(Pointer pointer, Pointer key) { + Table* table = &TABLE(pointer); + if (table->size == 0) return UNDEFINED; + unsigned i = key & (table->size - 1); + TableHash hash = table->data[i].hash; + + for (unsigned j = hash.offset + table->size; + j < hash.offset + table->size + hash.length; + j++) { + TablePair pair = table->data[j].pair; + if (pair.key == key) { + return pair.value; + } + } + + return UNDEFINED; +} + +static void addToTable(Table* table, Pointer key, Pointer value) { + unsigned i = key & table->size - 1; + TableHash* hash = &table->data[i].hash; + hash->length++; + for (unsigned j = table->size + table->length - 1; + j > table->size + hash->offset; + j--) { + table->data[j] = table->data[j - 1]; + } + + for (unsigned j = i + 1; j < table->size; j++) { + table->data[j].hash.offset++; + } + + TablePair* pair = &table->data[table->size + hash->offset].pair; + pair->key = key; + pair->value = value; +} + +Pointer table_set(Pointer pointer, Pointer key, Pointer value) { + Table* table = &TABLE(pointer); + unsigned i = key & table->size - 1; + TableHash hash = table->data[i].hash; + + for (unsigned j = hash.offset + table->size; + j < hash.offset + table->size + hash.length; + j++) { + TablePair* pair = &table->data[j].pair; + if (pair->key == key) { + pair->value = value; + return pointer; + } + } + + if (table->length == table->size) { + table->size = MAX(table->size * 2, 1); + pointer = memory_resize(pointer, sizeof(Table) + table->size * sizeof(TableData) * 2); + table = &TABLE(pointer); + + + // Move data at the end of the new data section. + for (unsigned j = table->length; j < table->size; j++) { + table->data[j + table->size] = table->data[j]; + } + + // Reset the hash section. + for (unsigned j = 0; j < table->size; j++) { + table->data[j].hash.offset = 0; + table->data[j].hash.length = 0; + } + + // Readd the data in the table. + for (unsigned j = table->size + table->length; j < table->size * 2; j++) { + addToTable(table, table->data[j].pair.key, table->data[j].pair.value); + } + } + + table->length++; + addToTable(table, key, value); + + return pointer; +} diff --git a/implementations/c/tests/Makefile.am b/implementations/c/tests/Makefile.am new file mode 100644 index 0000000..f92070b --- /dev/null +++ b/implementations/c/tests/Makefile.am @@ -0,0 +1,17 @@ +TESTS=check_ptlisp +check_PROGRAMS=check_ptlisp +check_ptlisp_SOURCES = \ + ptlisp-test.c \ + memory-test.c \ + array-test.c \ + table-test.c \ + symbol-test.c \ + string-test.c \ + cons-test.c \ + environment-test.c \ + evaluator-test.c \ + lisp-test.c \ + reader-test.c \ + printer-test.c +check_ptlisp_CFLAGS = @CHECK_CFLAGS@ +check_ptlisp_LDADD = $(top_builddir)/src/libptlisp.la @CHECK_LIBS@ diff --git a/implementations/c/tests/array-test.c b/implementations/c/tests/array-test.c new file mode 100644 index 0000000..5cc7490 --- /dev/null +++ b/implementations/c/tests/array-test.c @@ -0,0 +1,94 @@ +#include "ptlisp-test.h" +#include "../src/lisp.h" + +START_TEST(array_create_test) { + Pointer arr = array(1); + ck_assert_uint_eq(ARRAY(arr).length, 0); + ck_assert_uint_eq(ARRAY(arr).size, 1); +} +END_TEST + +START_TEST(array_new_empty_test) { + Pointer arr = array(0); + ck_assert_uint_eq(ARRAY(arr).length, 0); + ck_assert_uint_eq(ARRAY(arr).size, 0); +} +END_TEST + +START_TEST(array_push_test) { + Pointer arr = array(1); + arr = array_push(arr, 69); + ck_assert_uint_eq(ARRAY(arr).length, 1); + ck_assert_uint_eq(ARRAY(arr).size, 1); + ck_assert_uint_eq(ARRAY(arr).data[0], 69); + + arr = array_push(arr, 420); + ck_assert_uint_eq(ARRAY(arr).length, 2); + ck_assert_uint_eq(ARRAY(arr).size, 2); + ck_assert_uint_eq(ARRAY(arr).data[0], 69); + ck_assert_uint_eq(ARRAY(arr).data[1], 420); +} +END_TEST + +START_TEST(array_pop_test) { + Pointer arr = array(1); + ck_assert_uint_eq(array_pop(arr), NIL); + array_push(arr, 69); + ck_assert_uint_eq(ARRAY(arr).data[0], 69); + ck_assert_uint_eq(array_pop(arr), 69); + ck_assert_uint_eq(ARRAY(arr).length, 0); +} +END_TEST + +START_TEST(array_set_test) { + Pointer arr = array(1); + arr = array_set(arr, 0, 69); + arr = array_set(arr, 8, 420); + ck_assert_uint_eq(ARRAY(arr).data[0], 69); + ck_assert_uint_eq(ARRAY(arr).data[2], UNDEFINED); + ck_assert_uint_eq(ARRAY(arr).data[8], 420); + ck_assert_uint_eq(ARRAY(arr).length, 9); + ck_assert_uint_eq(ARRAY(arr).size, 16); +} +END_TEST + +START_TEST(array_get_test) { + Pointer arr = array(1); + arr = array_push(arr, 69); + ck_assert_uint_eq(array_get(arr, 0), 69); + ck_assert_uint_eq(array_get(arr, 9), UNDEFINED); +} +END_TEST + +START_TEST(array_length_test) { + Pointer arr = array(1); + ck_assert_uint_eq(array_length(arr), 0); + arr = array_push(arr, 69u); + ck_assert_uint_eq(array_length(arr), 1); +} +END_TEST + +static void setup(void) { + memory_init(16); +} + +static void teardown(void) { + memory_free(); +} + +Suite* make_array_test_suite(void) { + Suite *s1 = suite_create("Array"); + TCase *tc1_1 = tcase_create("Array"); + suite_add_tcase(s1, tc1_1); + + tcase_add_checked_fixture(tc1_1, setup, teardown); + tcase_add_test(tc1_1, array_create_test); + tcase_add_test(tc1_1, array_new_empty_test); + tcase_add_test(tc1_1, array_push_test); + tcase_add_test(tc1_1, array_pop_test); + tcase_add_test(tc1_1, array_set_test); + tcase_add_test(tc1_1, array_get_test); + tcase_add_test(tc1_1, array_length_test); + + return s1; +} diff --git a/implementations/c/tests/check_ptlisp.log b/implementations/c/tests/check_ptlisp.log new file mode 100644 index 0000000000000000000000000000000000000000..d4f6b29338123627e5affeb0f50a41d2e2ba0b34 GIT binary patch literal 9173 zcmeHNOK;mS4Bpwlf;$XoyQGk1$FEyablYJAie~r0j6(DygC6!L{IxkrgKbLMNOmZumnb1z$6+ z5T!>*_GGzv$m=#&LSkmz%FOgb;Ju#oS)ZzoR2ESN#KoL-o=$zAKkmB~4)x%3)ocvy z6BWiZ1atx?GV`+-F@cysOdMM@Vs&73V0B=1?Dw&bZ!RHEAWtAqAWuBS6ZWz)w-%bk zV+&1cubXLN%K|4C)5wmSxw8gs=O)e#F#Jwp=E zzmgsA1d9yryVFld!;p|TjYtyEh|H$#$Y_)C7@;2Hjj^Y>A9GcyyAtwKyBPQc`I*YxdgFgLF{orN#hlup%H#PoKC-?`Q*kR;! zHy8HhJOFhB^dyK$GAb3__NRp$lb#L+{SnY#q(1`s^YooKc7R)btw6ash2~b_7nWpY zNlGp833->n^*vktY%)mV8GOjAx|K|~G!Sm26tes2-Cix1u b => -1u + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + memory_destroy(d); // fl => d => b => -1u + /* ck_assert_uint_eq(MEMORY.freelist, d); */ + memory_destroy(c); // fl => b => -1u + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + ck_assert_uint_eq(NEXT(b), e + 2); + memory_free(); +} +END_TEST + +START_TEST(memory_free_merging2_test) { + memory_init(1024); + Pointer a, b, c, d, e; + a = memory_new(SYMBOL, 1); // 0 + b = memory_new(SYMBOL, 1); // 1 + c = memory_new(SYMBOL, 1); // 2 + d = memory_new(SYMBOL, 1); // 3 + e = memory_new(SYMBOL, 1); // 4 + memory_destroy(b); // fl => b => -1u + memory_destroy(c); // fl => b => -1u + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + ck_assert_uint_eq(NEXT(b), e + 2); + memory_free(); +} +END_TEST + +START_TEST(memory_free_merging3_test) { + memory_init(1024); + Pointer a, b, c, d, e; + a = memory_new(SYMBOL, 1); // 0 + b = memory_new(SYMBOL, 1); // 1 + c = memory_new(SYMBOL, 1); // 2 + d = memory_new(SYMBOL, 1); // 3 + e = memory_new(SYMBOL, 1); // 4 + memory_destroy(c); // fl => b => -1u + memory_destroy(b); // fl => b => -1u + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + ck_assert_uint_eq(NEXT(b), e + 2); + memory_free(); +} +END_TEST + +START_TEST(memory_realloc_test) { + memory_init(16); + Pointer a, b; + a = memory_new(SYMBOL, 1); // 0 + b = memory_resize(a, 1); + ck_assert_uint_eq(a, b); + ck_assert_uint_eq(SIZE(a), 2); + memory_free(); +} +END_TEST + +START_TEST(memory_realloc_shrink_test) { + memory_init(16 * 1); + Pointer a, b; + a = memory_new(SYMBOL, sizeof(Symbol) + 12); // 0 + b = memory_resize(a, sizeof(Symbol)); + ck_assert_uint_eq(a, b); + ck_assert_uint_eq(SIZE(a), 2); + /* ck_assert_uint_eq(MEMORY.freelist, 2); */ + memory_free(); +} +END_TEST + +START_TEST(memory_realloc_free_slot_test) { + memory_init(16); + Pointer a, b, c; + a = memory_new(SYMBOL, sizeof(Symbol) + 8); // 0 + b = memory_new(SYMBOL, sizeof(Symbol) + 1); + memory_destroy(b); + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + ck_assert_uint_eq(SIZE(b), 12); + c = memory_resize(a, sizeof(Symbol) + 16); + ck_assert_uint_eq(a, c); + ck_assert_uint_eq(SIZE(a), 4); + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + memory_free(); +} +END_TEST + +START_TEST(memory_realloc_free_big_slot_test) { + memory_init(16 * 1); + Pointer a, b, c; + a = memory_new(SYMBOL, 8); // 0 + b = memory_new(SYMBOL, 24); + memory_destroy(b); + /* ck_assert_uint_eq(MEMORY.freelist, b); */ + c = memory_resize(a, 16); + ck_assert_uint_eq(a, c); + ck_assert_uint_eq(memory_get(a)->size, 4); + /* ck_assert_uint_eq(MEMORY.freelist, 4); */ + memory_free(); +} +END_TEST + +START_TEST(memory_realloc_relocate_test) { + memory_init(16 * 1); + Pointer a, b, c; + a = memory_new(SYMBOL, 8); // 0 + b = memory_new(SYMBOL, 8); // 1 + /* ck_assert_uint_eq(MEMORY.freelist, 4); */ + ck_assert_uint_eq(SIZE(4), 12); + ck_assert_uint_eq(NEXT(4), -1u); + c = memory_resize(a, 16); + memory_free(); +} +END_TEST + +Suite* make_memory_test_suite(void) { + Suite *s1 = suite_create("Memory"); + TCase *tc1_1 = tcase_create("Memory"); + + suite_add_tcase(s1, tc1_1); + tcase_add_test(tc1_1, memory_alloc_test); + tcase_add_test(tc1_1, memory_basic_free_test); + tcase_add_test(tc1_1, memory_basic2_free_test); + tcase_add_test(tc1_1, memory_basic3_free_test); + tcase_add_test(tc1_1, memory_basic4_free_test); + tcase_add_test(tc1_1, memory_free_merging_test); + tcase_add_test(tc1_1, memory_free_merging2_test); + tcase_add_test(tc1_1, memory_free_merging3_test); + tcase_add_test(tc1_1, memory_realloc_test); + tcase_add_test(tc1_1, memory_realloc_shrink_test); + tcase_add_test(tc1_1, memory_realloc_free_slot_test); + tcase_add_test(tc1_1, memory_realloc_free_big_slot_test); + tcase_add_test(tc1_1, memory_realloc_relocate_test); + + return s1; +} diff --git a/implementations/c/tests/printer-test.c b/implementations/c/tests/printer-test.c new file mode 100644 index 0000000..a1eff00 --- /dev/null +++ b/implementations/c/tests/printer-test.c @@ -0,0 +1,61 @@ +#include "ptlisp-test.h" + +static Pointer STANDARD_OUTPUT_STREAM; +static char buffer[255]; +START_TEST(print_fn_test) { + Pointer list = LIST(number(1), number(2), number(69.420)); + Pointer result = print_fn(LIST(list, STANDARD_OUTPUT_STREAM), NIL); + ck_assert_str_eq(buffer, "\n(1 2 69.42) "); + ck_assert_uint_eq(list, result); + rewind(STREAM(STANDARD_OUTPUT_STREAM)); + + list = LIST(number(1), number(2), LIST(number(3), number(4))); + result = print_fn(LIST(list, STANDARD_OUTPUT_STREAM), NIL); + ck_assert_str_eq(buffer, "\n(1 2 (3 4)) "); + ck_assert_uint_eq(list, result); + rewind(STREAM(STANDARD_OUTPUT_STREAM)); + + Pointer tbl = table(4); + Pointer a = symbol("a", sizeof("a")); + Pointer b = symbol("b", sizeof("b")); + Pointer c = symbol("c", sizeof("c")); + Pointer d = symbol("d", sizeof("d")); + tbl = table_set(tbl, a, number(1)); + tbl = table_set(tbl, b, number(2)); + tbl = table_set(tbl, c, number(3)); + tbl = table_set(tbl, d, number(4)); + result = print_fn(LIST(tbl, STANDARD_OUTPUT_STREAM), NIL); + ck_assert_str_eq(buffer, "\n{c: 3, a: 1, d: 4, b: 2} "); + rewind(STREAM(STANDARD_OUTPUT_STREAM)); + + result = print_fn(LIST(character('a'), STANDARD_OUTPUT_STREAM), NIL); + fprintf(STREAM(STANDARD_OUTPUT_STREAM), "%c", '\0'); + fflush(STREAM(STANDARD_OUTPUT_STREAM)); + ck_assert_str_eq(buffer, "\n\\a "); + rewind(STREAM(STANDARD_OUTPUT_STREAM)); +} END_TEST + +static void setup(void) { + memory_init(16); + symbol_init(); + reader_init(); + environment_init(); + STANDARD_OUTPUT_STREAM = stream(fmemopen(buffer, sizeof(buffer), "w+")); + environment_set(NIL, STANDARD_OUTPUT, STANDARD_OUTPUT_STREAM); +} + +static void teardown(void) { + fclose(STREAM(STANDARD_OUTPUT_STREAM)); + memory_free(); +} + +Suite* make_printer_test_suite(void) { + Suite *s1 = suite_create("Printer"); + TCase *tc1_1 = tcase_create("Printer"); + suite_add_tcase(s1, tc1_1); + + tcase_add_checked_fixture(tc1_1, setup, teardown); + tcase_add_test(tc1_1, print_fn_test); + + return s1; +} diff --git a/implementations/c/tests/ptlisp-test.c b/implementations/c/tests/ptlisp-test.c new file mode 100644 index 0000000..211d6e4 --- /dev/null +++ b/implementations/c/tests/ptlisp-test.c @@ -0,0 +1,25 @@ +#include "ptlisp-test.h" +#include "../src/lisp.h" + +int main(void) { + SRunner *sr = srunner_create(make_memory_test_suite()); + int nf; + + srunner_add_suite(sr, make_array_test_suite()); + srunner_add_suite(sr, make_table_test_suite()); + srunner_add_suite(sr, make_symbol_test_suite()); + srunner_add_suite(sr, make_string_test_suite()); + srunner_add_suite(sr, make_cons_test_suite()); + srunner_add_suite(sr, make_environment_test_suite()); + srunner_add_suite(sr, make_evaluator_test_suite()); + srunner_add_suite(sr, make_lisp_test_suite()); + srunner_add_suite(sr, make_reader_test_suite()); + srunner_add_suite(sr, make_printer_test_suite()); + + srunner_set_fork_status(sr, CK_NOFORK); + srunner_run_all(sr, CK_NORMAL); + nf = srunner_ntests_failed(sr); + srunner_free(sr); + + return nf == 0 ? 0 : 1; +} diff --git a/implementations/c/tests/ptlisp-test.h b/implementations/c/tests/ptlisp-test.h new file mode 100644 index 0000000..bca99aa --- /dev/null +++ b/implementations/c/tests/ptlisp-test.h @@ -0,0 +1,16 @@ +#ifndef PTLISP_TEST_H +#define PTLISP_TEST_H +#include +#include "../src/lisp.h" +Suite* make_memory_test_suite(void); +Suite* make_array_test_suite(void); +Suite* make_table_test_suite(void); +Suite* make_symbol_test_suite(void); +Suite* make_string_test_suite(void); +Suite* make_cons_test_suite(void); +Suite* make_environment_test_suite(void); +Suite* make_evaluator_test_suite(void); +Suite* make_lisp_test_suite(void); +Suite* make_reader_test_suite(void); +Suite* make_printer_test_suite(void); +#endif diff --git a/implementations/c/tests/reader-test.c b/implementations/c/tests/reader-test.c new file mode 100644 index 0000000..c5df745 --- /dev/null +++ b/implementations/c/tests/reader-test.c @@ -0,0 +1,157 @@ +#include "ptlisp-test.h" + +static Pointer STANDARD_INPUT_STREAM; + +START_TEST(peek_char_test) { + Stream stream = STREAM(STANDARD_INPUT_STREAM); + ck_assert_uint_eq(peek_char(NIL, stream), 'h'); + ck_assert_uint_eq(peek_char(character('o'), stream), 'o'); + fseek(stream, 6, SEEK_SET); + ck_assert_uint_eq(peek_char(T, stream), 'w'); + rewind(stream); + ck_assert_uint_eq(peek_char(character('z'), stream), 0); +} END_TEST + +START_TEST(peek_char_fn_test) { + ck_assert_uint_eq(CHAR(peek_char_fn(LIST(NIL, STANDARD_INPUT_STREAM), NIL)), 'h'); + ck_assert_uint_eq(CHAR(peek_char_fn(NIL, NIL)), 'h'); +} END_TEST + +START_TEST(read_char_fn_test) { + ck_assert_uint_eq(CHAR(read_char_fn(LIST(STANDARD_INPUT_STREAM), NIL)), 'h'); + ck_assert_uint_eq(CHAR(read_char_fn(NIL, NIL)), 'e'); + ck_assert_uint_eq(CHAR(peek_char_fn(LIST(NIL, STANDARD_INPUT_STREAM), NIL)), 'l'); +} END_TEST + +START_TEST(read_fn_test) { + FILE* s; + + printf("%s: %d\n", __FILE__, __LINE__); + char hello[] = "hello"; + s = fmemopen(hello, sizeof(hello), "r"); + printf("%s: %d\n", __FILE__, __LINE__); + ck_assert_str_eq(SYMBOL(read_fn(LIST(stream(s)), NIL)).data, hello); + printf("%s: %d\n", __FILE__, __LINE__); + fclose(s); + + char funny[] = "69.420"; + s = fmemopen(funny, sizeof(funny), "r"); + ck_assert_double_eq(NUMBER(read_fn(LIST(stream(s)), NIL)), 69.420); + printf("%s: %d\n", __FILE__, __LINE__); + fclose(s); + + char list[] = "(1 2 3)"; + s = fmemopen(list, sizeof(list), "r"); + Pointer result = read_fn(LIST(stream(s)), NIL); + printf("%s: %d: %d\n", __FILE__, __LINE__, TYPE(CAR(result))); + ck_assert_double_eq(NUMBER(CAR(result)), 1); + ck_assert_double_eq(NUMBER(CAR(CDR(result))), 2); + ck_assert_double_eq(NUMBER(CAR(CDR(CDR(result)))), 3); + fclose(s); +} END_TEST + +START_TEST(set_reader_macro_test) { + ck_assert_uint_eq(set_reader_macro(69, 420), T); + /* ck_assert_uint_eq(table_get(READTABLE, 69), 420); */ +} END_TEST + +START_TEST(set_reader_macro_fn_test) { + ck_assert_uint_eq(set_reader_macro_fn(LIST(69, 420)), T); + /* ck_assert_uint_eq(table_get(READTABLE, 69), 420); */ +} END_TEST + +START_TEST(read_char_macro_fn_test) { + FILE* s; + + char a[] = "a"; + s = fmemopen(a, sizeof(a), "r"); + ck_assert_uint_eq(CHAR(read_char_macro_fn(LIST(stream(s)), NIL)), 'a'); + fclose(s); + + char ab[] = "ab"; + s = fmemopen(ab, sizeof(ab), "r"); + ck_assert_uint_eq(read_char_macro_fn(LIST(stream(s)), NIL), UNDEFINED); + fclose(s); + + unsigned char smile[] = "😄"; + s = fmemopen(smile, sizeof(smile), "r"); + Pointer result = read_char_macro_fn(LIST(stream(s)), NIL); + ck_assert_int_eq(CHAR(result) & 0xFF, smile[0]); + ck_assert_int_eq((CHAR(result) >> 8) & 0xFF, smile[1]); + ck_assert_int_eq((CHAR(result) >> 16) & 0xFF, smile[2]); + ck_assert_int_eq((CHAR(result) >> 24) & 0xFF, smile[3]); + fclose(s); + + char smile2[] = "😄😄"; + s = fmemopen(smile2, sizeof(smile2), "r"); + ck_assert_uint_eq(read_char_macro_fn(LIST(stream(s)), NIL), UNDEFINED); + fclose(s); + + char space[] = "space"; + s = fmemopen(space, sizeof(space), "r"); + ck_assert_uint_eq(CHAR(read_char_macro_fn(LIST(stream(s)), NIL)), ' '); + fclose(s); + + char tab[] = "tab"; + s = fmemopen(tab, sizeof(tab), "r"); + ck_assert_uint_eq(CHAR(read_char_macro_fn(LIST(stream(s)), NIL)), '\t'); + fclose(s); + + char newline[] = "newline"; + s = fmemopen(newline, sizeof(newline), "r"); + ck_assert_uint_eq(CHAR(read_char_macro_fn(LIST(stream(s)), NIL)), '\n'); + fclose(s); + + char space2[] = "space2"; + s = fmemopen(space2, sizeof(space2), "r"); + ck_assert_uint_eq(read_char_macro_fn(LIST(stream(s)), NIL), UNDEFINED); + fclose(s); +} END_TEST + +START_TEST(read_list_macro_fn_test) { + char list[] = "1 2 3)"; + FILE* s = fmemopen(list, sizeof(list), "r"); + Pointer result = read_list_macro_fn(LIST(stream(s)), NIL); + ck_assert_double_eq(NUMBER(CAR(result)), 1); + ck_assert_double_eq(NUMBER(CAR(CDR(result))), 2); + ck_assert_double_eq(NUMBER(CAR(CDR(CDR(result)))), 3); + fclose(s); +} END_TEST + +START_TEST(read_right_paren_macro_fn_test) { + ck_assert_uint_eq(read_right_paren_macro_fn(NIL, NIL), NIL); +} END_TEST + +static char buffer[] = "hello, world"; +static void setup(void) { + memory_init(16); + symbol_init(); + reader_init(); + environment_init(); + STANDARD_INPUT_STREAM = stream(fmemopen(buffer, sizeof(buffer), "r")); + environment_set(NIL, STANDARD_INPUT, STANDARD_INPUT_STREAM); +} + +static void teardown(void) { + fclose(STREAM(STANDARD_INPUT_STREAM)); + memory_free(); +} + +Suite* make_reader_test_suite(void) { + Suite *s1 = suite_create("Reader"); + TCase *tc1_1 = tcase_create("Reader"); + suite_add_tcase(s1, tc1_1); + + tcase_add_checked_fixture(tc1_1, setup, teardown); + tcase_add_test(tc1_1, peek_char_test); + tcase_add_test(tc1_1, peek_char_fn_test); + tcase_add_test(tc1_1, read_char_fn_test); + tcase_add_test(tc1_1, read_fn_test); + tcase_add_test(tc1_1, set_reader_macro_test); + tcase_add_test(tc1_1, set_reader_macro_fn_test); + tcase_add_test(tc1_1, read_char_macro_fn_test); + tcase_add_test(tc1_1, read_list_macro_fn_test); + tcase_add_test(tc1_1, read_right_paren_macro_fn_test); + + return s1; +} diff --git a/implementations/c/tests/string-test.c b/implementations/c/tests/string-test.c new file mode 100644 index 0000000..f2a97e4 --- /dev/null +++ b/implementations/c/tests/string-test.c @@ -0,0 +1,49 @@ +#include "ptlisp-test.h" +#include "../src/lisp.h" + +START_TEST(str_create_test) { + char chars[] = "Hello, world!"; + size_t size = sizeof(chars); + Pointer str = string(chars, size); + + ck_assert_uint_eq(STRING(str).length, size); + for (size_t i = 0; i < size; i++) { + ck_assert_uint_eq(STRING(str).data[i], chars[i]); + } +} +END_TEST + +START_TEST(str_push_test) { + char chars[] = "Hello, world!"; + size_t size = sizeof(chars); + Pointer str = string(chars, size); + string_push(str, '?'); + + ck_assert_uint_eq(STRING(str).length, size + 1); + for (unsigned i = 0; i < size; i++) { + ck_assert_uint_eq(STRING(str).data[i], chars[i]); + } + + ck_assert_uint_eq(STRING(str).data[size], '?'); +} +END_TEST + +static void setup(void) { + memory_init(16); +} + +static void teardown(void) { + memory_free(); +} + +Suite* make_string_test_suite(void) { + Suite *s1 = suite_create("String"); + TCase *tc1_1 = tcase_create("String"); + suite_add_tcase(s1, tc1_1); + + tcase_add_checked_fixture(tc1_1, setup, teardown); + tcase_add_test(tc1_1, str_create_test); + tcase_add_test(tc1_1, str_push_test); + + return s1; +} diff --git a/implementations/c/tests/symbol-test.c b/implementations/c/tests/symbol-test.c new file mode 100644 index 0000000..55cdb97 --- /dev/null +++ b/implementations/c/tests/symbol-test.c @@ -0,0 +1,62 @@ +#include "ptlisp-test.h" +#include "../src/lisp.h" + + +START_TEST(sym_create_unexistant_empty_test) { + char string[] = "Hello, world!"; + Pointer a = symbol(string, sizeof(string)); + + char string2[] = "Goodbye, world!"; + Pointer b = symbol(string2, sizeof(string2)); + + ck_assert_uint_ne(a, b); + /* ck_assert_uint_eq(ARRAY(SYMBOLS).length, 2); */ + /* ck_assert_uint_eq(array_get(SYMBOLS, 1), b); */ +} +END_TEST + +START_TEST(sym_create_unexistant_test) { + char string[] = "Hello, world!"; + size_t size = sizeof(string); + Pointer sym = symbol(string, size); + + /* ck_assert_uint_eq(ARRAY(SYMBOLS).length, 1); */ + /* ck_assert_uint_eq(array_get(SYMBOLS, 0), sym); */ + ck_assert_uint_eq(SYMBOL(sym).length, size); +} +END_TEST + +START_TEST(sym_create_existant_test) { + char string[] = "Hello, world!"; + size_t size = sizeof(string); + Pointer existant = symbol(string, size); + Pointer sym = symbol(string, size); + + ck_assert_uint_eq(existant, sym); + /* ck_assert_uint_eq(ARRAY(SYMBOLS).length, 1); */ + /* ck_assert_uint_eq(array_get(SYMBOLS, 0), sym); */ + ck_assert_uint_eq(SYMBOL(sym).length, size); +} +END_TEST + +static void setup(void) { + memory_init(16); + symbol_init(); +} + +static void teardown(void) { + memory_free(); +} + +Suite* make_symbol_test_suite(void) { + Suite *s1 = suite_create("Symbol"); + TCase *tc1_1 = tcase_create("Symbol"); + suite_add_tcase(s1, tc1_1); + + tcase_add_checked_fixture(tc1_1, setup, teardown); + tcase_add_test(tc1_1, sym_create_unexistant_empty_test); + tcase_add_test(tc1_1, sym_create_unexistant_test); + tcase_add_test(tc1_1, sym_create_existant_test); + + return s1; +} diff --git a/implementations/c/tests/table-test.c b/implementations/c/tests/table-test.c new file mode 100644 index 0000000..f803887 --- /dev/null +++ b/implementations/c/tests/table-test.c @@ -0,0 +1,78 @@ +#include "ptlisp-test.h" +#include "../src/lisp.h" + +START_TEST(table_create_test) { + Pointer tbl = table(3); + ck_assert_uint_eq(TABLE(tbl).length, 0); + ck_assert_uint_eq(TABLE(tbl).size, 4); +} +END_TEST + +START_TEST(table_get_existent_test) { + Pointer tbl = table(3); + tbl = table_set(tbl, 1, 2); + ck_assert_uint_eq(table_get(tbl, 1), 2); +} +END_TEST + +START_TEST(table_get_unexistent_test) { + ck_assert_uint_eq(table_get(table(3), 1), UNDEFINED); +} +END_TEST + +START_TEST(table_set_existent_test) { + Pointer tbl = table(3); + tbl = table_set(tbl, 1, 2); + tbl = table_set(tbl, 1, 69); + ck_assert_uint_eq(table_get(tbl, 1), 69); + ck_assert_uint_eq(TABLE(tbl).length, 1); +} +END_TEST + +START_TEST(table_set_unexistent_test) { + Pointer tbl = table(3); + tbl = table_set(tbl, 1, 2); + ck_assert_uint_eq(table_get(tbl, 1), 2); + ck_assert_uint_eq(TABLE(tbl).length, 1); +} +END_TEST + +START_TEST(table_set_many_test) { + Pointer tbl = table(8); + tbl = table_set(tbl, 1, 1); + tbl = table_set(tbl, 2, 2); + tbl = table_set(tbl, 3, 3); + tbl = table_set(tbl, 4, 4); + tbl = table_set(tbl, 5, 5); + ck_assert_uint_eq(table_get(tbl, 1), 1); + ck_assert_uint_eq(table_get(tbl, 2), 2); + ck_assert_uint_eq(table_get(tbl, 3), 3); + ck_assert_uint_eq(table_get(tbl, 4), 4); + ck_assert_uint_eq(table_get(tbl, 5), 5); + ck_assert_uint_eq(TABLE(tbl).length, 5); +} +END_TEST + +static void setup(void) { + memory_init(16); +} + +static void teardown(void) { + memory_free(); +} + +Suite* make_table_test_suite(void) { + Suite *s1 = suite_create("Table"); + TCase *tc1_1 = tcase_create("Table"); + suite_add_tcase(s1, tc1_1); + + tcase_add_checked_fixture(tc1_1, setup, teardown); + tcase_add_test(tc1_1, table_create_test); + tcase_add_test(tc1_1, table_get_existent_test); + tcase_add_test(tc1_1, table_get_unexistent_test); + tcase_add_test(tc1_1, table_set_existent_test); + tcase_add_test(tc1_1, table_set_unexistent_test); + tcase_add_test(tc1_1, table_set_many_test); + + return s1; +} diff --git a/implementations/c/tests/test-suite.log b/implementations/c/tests/test-suite.log new file mode 100644 index 0000000..9488b0d --- /dev/null +++ b/implementations/c/tests/test-suite.log @@ -0,0 +1,14 @@ +====================================== + ptlisp 0.1: tests/test-suite.log +====================================== + +# TOTAL: 1 +# PASS: 1 +# SKIP: 0 +# XFAIL: 0 +# FAIL: 0 +# XPASS: 0 +# ERROR: 0 + +.. contents:: :depth: 2 + diff --git a/implementations/js/datatypes.js b/implementations/js/datatypes.js new file mode 100644 index 0000000..a117750 --- /dev/null +++ b/implementations/js/datatypes.js @@ -0,0 +1,151 @@ +export const DataTypes = { + Symbol: 'symbol', + Nil: 'nil', + True: 'true', + Number: 'number', + String: 'string', + Function: 'function', + SpecialForm: 'special-form', + Cons: 'cons', + Macro: 'macro' +} + +export class DataType { + constructor (type) { + this.type = type; + } +} + +export class Atom extends DataType { + constructor (type, value) { + super(type); + this.value = value; + } +} + +export class Symbol extends Atom { + constructor (value) { + super(DataTypes.Symbol, value); + } +} + +export class Nil extends Atom { + constructor() { + super(DataTypes.Nil, null); + } +} + +export class True extends Atom { + constructor() { + super(DataTypes.True, true); + } +} + +export class Number extends Atom { + constructor(value) { + super(DataTypes.Number, value); + } +} + +export class String extends Atom { + constructor(value) { + super(DataTypes.String, value); + } +} + +export class Function extends Atom { + constructor(value, sexp, env) { + super(DataTypes.Function, value); + this.sexp = sexp; + this.env = env; + } +} + +export class SpecialForm extends Atom { + constructor(value) { + super(DataTypes.SpecialForm, value); + } +} + +export class Cons extends DataType { + constructor(car = new Nil(), cdr = new Nil()) { + super(DataTypes.Cons); + this.car = car; + this.cdr = cdr; + } + + // Optimise for tail call. + static async reduce(cons, fn, start) { + if (cons.car) { + start = await fn(start, cons.car); + } + + if (cons.cdr.type == DataTypes.Nil) { + return start; + } + + if (cons.cdr.type === DataTypes.Cons) { + return await Cons.reduce(cons.cdr, fn, start); + } else { + return await fn(start, cons.cdr); + } + } + + // Optimise for tail call. + static async map(cons, fn) { + if (cons.car) { + return new Cons( + await fn(cons.car), + cons.cdr.type === DataTypes.Nil + ? cons.cdr + : await Cons.map(cons.cdr, fn) + ); + } + + return cons; + } + + static zip(cons, list) { + const fn = (cons, list, result) => { + result = new Cons(new Cons(cons.car, list.car), result); + if (cons.cdr.type === DataTypes.Nil || list.cdr === DataTypes.Nil) + { + return result; + } + + return fn(cons.cdr, list.cdr, result); + } + + return Cons.reverse(fn(cons, list, new Nil)); + } + + static reverse(cons) { + const fn = (cons, last) => { + let next = cons.cdr; + cons.cdr = last; + if (next.type === DataTypes.Nil) { + return cons; + } + return fn(next, cons); + }; + return fn(cons, new Nil()); + } + + static nth(cons, i) { + if (i > 0) { + return Cons.nth(cons.cdr.nth, i - 1); + } + + return cons.car; + } + + static last(cons) { + return Cons.reverse(cons).car; + } +} + +export class Macro extends Atom { + constructor(value) { + super(DataTypes.Macro, value); + } +} diff --git a/implementations/js/env.js b/implementations/js/env.js new file mode 100644 index 0000000..6797f6f --- /dev/null +++ b/implementations/js/env.js @@ -0,0 +1,29 @@ +export class Env { + constructor(outer, data = {}) { + this.outer = outer; + this.data = data; + } + + static set(env, key, val) { + if (env.data[key] || + env.outer === null) { + return env.data[key] = val; + } + + return Env.set(env.outer, key, val); + } + + static find(env, key) { + return env.data[key] || + (env.outer && Env.find(env.outer, key)); + } + + static get(env, key) { + const o = Env.find(env, key); + if (o === null) { + throw new Error(`Not found: ${key}`); + } + + return o; + } +} diff --git a/implementations/js/evaluator.js b/implementations/js/evaluator.js new file mode 100644 index 0000000..eeca4ad --- /dev/null +++ b/implementations/js/evaluator.js @@ -0,0 +1,64 @@ +import { DataTypes, Cons, Nil } from './datatypes.js'; +import { Env } from './env.js'; + +export class Evaluator { + static async expand(sexp, macros) { + if (sexp.type === DataTypes.Cons) { + const op = await Evaluator.expand(sexp.car, macros) + if (op.type === DataTypes.SpecialForm) { + return await op.value(sexp.cdr, macros, macros); + } else if (op.type === DataTypes.Macro) { + return await op.value( + await Cons.map(sexp.cdr, + async o => await Evaluator.expand(o, macros))); + // return (sexp.cdr.type === DataTypes.Nil + // ? sexp.cdr + // : Cons.reverse(await Cons.reduce( + // sexp.cdr, + // (p, o) => new Cons(await Evaluator.expand(o, macros), p), + // new Nil()))) + // .then(opts => op.value(opts)); + } else if (sexp.type === DataTypes.Symbol) { + return Env.find(macros, sexp.value) || sexp; + } + + return sexp; + } + + if (sexp.type === DataTypes.Symbol) { + return Env.find(macros, sexp.value) || sexp; + } + + return sexp; + } + + static async eval(sexp, env, macros) { + sexp = await Evaluator.expand(sexp, macros) + if (sexp.type === DataTypes.Cons) { + const op = await Evaluator.eval(sexp.car, env, macros) + if (op.type === DataTypes.SpecialForm) { + return await op.value(sexp.cdr, env, macros); + } else if (op.type === DataTypes.Function) { + return await op.value(await Cons.map(sexp.cdr, async o => Evaluator.eval(o, env, macros))); + // return (sexp.cdr.type === DataTypes.Nil + // ? Promise.resolve(sexp.cdr) + // : Cons.reduce( + // sexp.cdr, + // (p, o) => p.then(v => Evaluator.eval(o, env, macros) + // .then(ve => new Cons(ve, v))), + // Promise.resolve(new Nil())) + // .then(v => Cons.reverse(v))) + // .then(opts => op.value(opts)); + } + + throw 'Illegal function call'; + } + + if (sexp.type === DataTypes.Symbol) { + return Env.get(env, sexp.value); + } + + return sexp; + + } +} diff --git a/implementations/js/index.html b/implementations/js/index.html new file mode 100644 index 0000000..d37dca3 --- /dev/null +++ b/implementations/js/index.html @@ -0,0 +1,87 @@ + + + + + Pariatech's Lisp + + + + 
+ ____                               __                  __         
+/\  _`\                __          /\ \__              /\ \        
+\ \ \L\ \ __     _ __ /\_\     __  \ \ ,_\    __    ___\ \ \___    
+ \ \ ,__/'__`\  /\`'__\/\ \  /'__`\ \ \ \/  /'__`\ /'___\ \  _ `\  
+  \ \ \/\ \L\.\_\ \ \/ \ \ \/\ \L\.\_\ \ \_/\  __//\ \__/\ \ \ \ \ 
+   \ \_\ \__/.\_\\ \_\  \ \_\ \__/.\_\\ \__\ \____\ \____\\ \_\ \_\
+    \/_/\/__/\/_/ \/_/   \/_/\/__/\/_/ \/__/\/____/\/____/ \/_/\/_/
+
+

Operations: + - * / def let fn set = not if and or < <= > >= print princ eval cons list car cdr + eval quote ' quasiquote ` unquote , unquote-splicing ,@ expand macro defmacro defn read save load load-from-file

+

+USER >  

+ + +