diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +# 0.2.0.0 + + * Complete implementation of folds/maps for lists + * Fix space leak in folds + * Fix line splitting (no longer discard blank lines) + * Dfn fix + * Allow escaped characters in strings + * Add several builtin functions + * Location information when reporting errors related to typeclasses + * Option type + * Selectors for tuples + # 0.1.0.0 * Initial release diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/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/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,14 +0,0 @@ -Copyright (C) 2021-2022 Vanessa McHale - -This program is free software: you can redistribute it and/or modify -it under the terms of the GNU 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 General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program. If not, see . diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ ## From Source -First, install [Rust's regex library](https://github.com/rust-lang/regex/tree/master/regex-capi#c-api-for-rusts-regex-engine). +First, install [Rust's regex library](https://github.com/rust-lang/regex/tree/master/regex-capi#c-api-for-rusts-regex-engine). You'll need to put `librure.so` or `librure.dylib` etc. in the appropriate place. If you have [cabal](https://www.haskell.org/cabal/) and [GHC](https://www.haskell.org/ghc/) installed (perhaps via [ghcup](https://www.haskell.org/ghcup/)): @@ -13,10 +13,6 @@ cabal install jacinda ``` -# Documentation - -The manpages document the builtins and provide a syntax reference. - # SHOCK & AWE ``` @@ -27,6 +23,42 @@ curl -sL https://raw.githubusercontent.com/nychealth/coronavirus-data/master/latest/now-weekly-breakthrough.csv | \ ja ',[1.0-x%y] {ix>1}{`5:f} {ix>1}{`11:f}' -F, ``` + +# Documentation + +See the [guide](https://vmchale.github.io/jacinda/), which contains a tutorial +on some of the features as well as examples. + +The manpages document the builtins and provide a syntax reference. + +# Status + +The project is in alpha stage, it doesn't necessarily work and there are many +missing features, but the language will remain stable. + +It is worse than awk but it has its place and it avoids some of the painful +imperative/scoping defects. + +## Missing Features & Bugs + + * `sub`/`gsub` function equivalents + * No nested dfns + * Obscure renamer edge cases during evaluation + * Multiple folds are criminally inefficient + * Documentation for tuples, `Option` type + * `printf` formatting for floats + * No list literal syntax + * Typeclasses are not documented + * Type system is questionable + * Postfix `:f` and `:i` are handled poorly + * File imports/includes + +Intentionally missing features: + + * No loops + * No conditionals + +The latter in particular I may add if necessary # Further Advantages diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -2,6 +2,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL +import Data.Semigroup ((<>)) import qualified Data.Version as V import Jacinda.File import Options.Applicative diff --git a/doc/guide.pdf b/doc/guide.pdf new file mode 100644 Binary files /dev/null and b/doc/guide.pdf differ diff --git a/jacinda.cabal b/jacinda.cabal --- a/jacinda.cabal +++ b/jacinda.cabal @@ -1,8 +1,8 @@ cabal-version: 2.0 name: jacinda -version: 0.1.0.0 -license: GPL-3 -license-file: LICENSE +version: 0.2.0.0 +license: AGPL-3 +license-file: COPYING maintainer: vamchale@gmail.com author: Vanessa McHale bug-reports: https://github.com/vmchale/jacinda/issues @@ -16,6 +16,9 @@ CHANGELOG.md README.md man/ja.1 + doc/guide.pdf + test/examples/*.jac + lib/*.jac source-repository head type: git @@ -30,8 +33,6 @@ Jacinda.Ty.Const Jacinda.Regex Jacinda.File - Jacinda.Rename - Jacinda.Backend.TreeWalk build-tool-depends: alex:alex, happy:happy hs-source-dirs: src @@ -39,12 +40,14 @@ Jacinda.Lexer Intern.Name Intern.Unique + Jacinda.Rename Jacinda.Backend.Normalize + Jacinda.Backend.TreeWalk Jacinda.Backend.Printf Data.List.Ext default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -O2 build-depends: base >=4.10.0.0 && <5, bytestring >=0.11.0.0, @@ -80,7 +83,7 @@ other-modules: Paths_jacinda autogen-modules: Paths_jacinda default-language: Haskell2010 - ghc-options: -Wall -rtsopts -with-rtsopts=-A100k + ghc-options: -Wall -rtsopts -with-rtsopts=-A200k build-depends: base, jacinda-lib, diff --git a/lib/example.jac b/lib/example.jac new file mode 100644 --- /dev/null +++ b/lib/example.jac @@ -0,0 +1,10 @@ +fn sum(x) := + (+)|0 x; + +fn map(f, x) := + f"x; + +fn count (x) := + sum (map ([:1) x); + +sum $1:i diff --git a/man/ja.1 b/man/ja.1 --- a/man/ja.1 +++ b/man/ja.1 @@ -48,19 +48,22 @@ (a -> b -> c) -> Stream a -> Stream b -> Stream c .TP \f[B]|\f[R] Ternary operator: fold -(b -> a -> b) -> b -> Stream a -> b +Foldable f :=> (b -> a -> b) -> b -> f a -> b .TP \f[B]\[ha]\f[R] Ternary operator: scan (b -> a -> b) -> b -> Stream a -> Stream b .TP \f[B]\[lq]\f[R] Binary operator: map -a -> b -> Stream a -> Stream b +Functor f :=> a -> b -> f a -> f b .TP \f[B][:\f[R] Unary operator: const a -> b -> a .TP \f[B]#.\f[R] Binary operator: filter (a -> Bool) -> Stream a -> Stream a +.TP +\f[B].\f[R] Binary operator: prior +(a -> a -> a) -> Stream a -> Stream a .PP \f[B]max\f[R] Maximum of two values .PP @@ -84,6 +87,9 @@ \f[B]split\f[R] Split a string by regex Str -> Regex -> List Str .TP +\f[B]splitc\f[R] Split a string on a single character +Str -> Str -> List Str +.TP \f[B]floor\f[R] Floor function Float -> Int .TP @@ -92,6 +98,13 @@ .PP \f[B]sprintf\f[R] Convert an expression to a string using the format string +.TP +\f[B]option\f[R] Option eliminator +b -> (a -> b) -> Option a -> b +.TP +\f[B]match\f[R] +Str -> Regex -> Option (Int . +Int) .SS SYNTAX .PP \f[B]\[ga]n\f[R] nth field @@ -109,10 +122,18 @@ \f[B]#t\f[R] Boolean literal .PP \f[B]_n\f[R] Negative number +.TP +\f[B].n\f[R] Extract the nth value +List a -> a +.PP +\f[B]->n\f[R] Get the nth element of a tuple .SH BUGS .PP Please report any bugs you may come across to https://github.com/vmchale/jacinda/issues +.SS Limitations +.PP +Note that \f[C]Option\f[R] is not implemented as a functor. .SH COPYRIGHT .PP Copyright 2021-2022. diff --git a/src/Jacinda/AST.hs b/src/Jacinda/AST.hs --- a/src/Jacinda/AST.hs +++ b/src/Jacinda/AST.hs @@ -16,6 +16,7 @@ , D (..) , Program (..) , C (..) + , N (..) , mapExpr , getFS -- * Base functors @@ -45,7 +46,7 @@ | TyStream | TyVec | TyBool - | TyOptional + | TyOption -- TODO: tyRegex -- TODO: convert float to int deriving (Eq, Ord) @@ -71,14 +72,14 @@ -- TODO: type vars, products... instance Pretty TB where - pretty TyInteger = "Integer" - pretty TyStream = "Stream" - pretty TyBool = "Bool" - pretty TyStr = "Str" - pretty TyFloat = "Float" - pretty TyDate = "Date" - pretty TyVec = "List" - pretty TyOptional = "Optional" + pretty TyInteger = "Integer" + pretty TyStream = "Stream" + pretty TyBool = "Bool" + pretty TyStr = "Str" + pretty TyFloat = "Float" + pretty TyDate = "Date" + pretty TyVec = "List" + pretty TyOption = "Optional" instance Pretty (T a) where pretty (TyB _ b) = pretty b @@ -95,6 +96,7 @@ | Const | Not -- ^ Boolean | At Int + | Select Int | IParse | FParse | Floor @@ -102,20 +104,22 @@ deriving (Eq) instance Pretty BUn where - pretty Tally = "#" - pretty Const = "[:" - pretty Not = "!" - pretty (At i) = "." <> pretty i - pretty IParse = ":i" - pretty FParse = ":f" - pretty Floor = "floor" - pretty Ceiling = "ceil" + pretty Tally = "#" + pretty Const = "[:" + pretty Not = "!" + pretty (At i) = "." <> pretty i + pretty (Select i) = "->" <> pretty i + pretty IParse = ":i" + pretty FParse = ":f" + pretty Floor = "floor" + pretty Ceiling = "ceil" -- ternary data BTer = ZipW | Fold | Scan | Substr + | Option deriving (Eq) instance Pretty BTer where @@ -123,6 +127,7 @@ pretty Fold = "|" pretty Scan = "^" pretty Substr = "substr" + pretty Option = "option" -- builtin data BBin = Plus @@ -143,9 +148,11 @@ | Min | Max | Split + | Splitc | Prior | Filter | Sprintf + | Match -- TODO: floor functions, sqrt, sin, cos, exp. (power) deriving (Eq) @@ -170,7 +177,9 @@ pretty Prior = "\\." pretty Filter = "#." pretty Split = "split" + pretty Splitc = "splitc" pretty Sprintf = "sprintf" + pretty Match = "match" data DfnVar = X | Y deriving (Eq) @@ -178,11 +187,15 @@ pretty X = "x" pretty Y = "y" +-- 0-ary +data N = Ix + deriving (Eq) + -- expression data E a = Column { eLoc :: a, col :: Int } | IParseCol { eLoc :: a, col :: Int } -- always a column | FParseCol { eLoc :: a, col :: Int } - | Field { eLoc :: a, field :: Int } + | Field { eLoc :: a, eField :: Int } | AllField { eLoc :: a } -- ^ Think @$0@ in awk. | AllColumn { eLoc :: a } -- ^ Think @$0@ in awk. | EApp { eLoc :: a, eApp0 :: E a, eApp1 :: E a } @@ -202,12 +215,13 @@ | BBuiltin { eLoc :: a, eBin :: BBin } | TBuiltin { eLoc :: a, eTer :: BTer } | UBuiltin { eLoc :: a, eUn :: BUn } - | Ix { eLoc :: a } -- only 0-ary builtin atm + | NBuiltin { eLoc :: a, eNil :: N } | Tup { eLoc :: a, esTup :: [E a] } | ResVar { eLoc :: a, dfnVar :: DfnVar } | RegexCompiled RurePtr -- holds compiled regex (after normalization) | Arr { eLoc :: a, elems :: V.Vector (E a) } | Paren { eLoc :: a, eExpr :: E a } + | OptionVal { eLoc :: a, eMaybe :: Maybe (E a) } -- TODO: regex literal deriving (Functor, Generic) -- TODO: side effects: allow since it's strict? @@ -237,16 +251,20 @@ | BBuiltinF a BBin | TBuiltinF a BTer | UBuiltinF a BUn - | IxF a + | NBuiltinF a N | TupF a [x] | ResVarF a DfnVar | RegexCompiledF RurePtr | ArrF a (V.Vector x) | ParenF a x + | OptionValF a (Maybe x) deriving (Generic, Functor, Foldable, Traversable) type instance Base (E a) = (EF a) +instance Pretty N where + pretty Ix = "ix" + instance Pretty (E a) where pretty (Column _ i) = "$" <> pretty i pretty AllColumn{} = "$0" @@ -258,6 +276,8 @@ pretty (EApp _ (EApp _ (BBuiltin _ Max) e) e') = "max" <+> pretty e <+> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ Min) e) e') = "min" <+> pretty e <+> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ Split) e) e') = "split" <+> pretty e <+> pretty e' + pretty (EApp _ (EApp _ (BBuiltin _ Splitc) e) e') = "splitc" <+> pretty e <+> pretty e' + pretty (EApp _ (EApp _ (BBuiltin _ Match) e) e') = "match" <+> pretty e <+> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ Sprintf) e) e') = "sprintf" <+> pretty e <+> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ Map) e) e') = pretty e <> "\"" <> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ b) e) e') = pretty e <+> pretty b <+> pretty e' @@ -266,7 +286,9 @@ pretty (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) e) e') e'') = pretty e <> "^" <> pretty e' <+> pretty e'' pretty (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) e') e'') = "," <> pretty op <+> pretty e' <+> pretty e'' pretty (EApp _ (EApp _ (EApp _ (TBuiltin _ Substr) e) e') e'') = "substr" <+> pretty e <+> pretty e' <+> pretty e'' - pretty (EApp _ (UBuiltin _ (At i)) e') = pretty e' <> "." <> pretty i + pretty (EApp _ (EApp _ (EApp _ (TBuiltin _ Option) e) e') e'') = "option" <+> pretty e <+> pretty e' <+> pretty e'' + pretty (EApp _ (UBuiltin _ (At i)) e) = pretty e <> "." <> pretty i + pretty (EApp _ (UBuiltin _ (Select i)) e) = pretty e <> "->" <> pretty i pretty (EApp _ (UBuiltin _ IParse) e') = pretty e' <> ":i" pretty (EApp _ (UBuiltin _ FParse) e') = pretty e' <> ":f" pretty (EApp _ e@UBuiltin{} e') = pretty e <> pretty e' @@ -286,11 +308,13 @@ pretty (Dfn _ e) = brackets (pretty e) pretty (Guarded _ p e) = braces (pretty p) <> braces (pretty e) pretty (Implicit _ e) = braces ("|" <+> pretty e) - pretty Ix{} = "ix" + pretty (NBuiltin _ n) = pretty n pretty RegexCompiled{} = error "Nonsense." pretty (Let _ (n, b) e) = "let" <+> "val" <+> pretty n <+> ":=" <+> pretty b <+> "in" <+> pretty e <+> "end" pretty (Paren _ e) = parens (pretty e) pretty (Arr _ es) = tupledByFunky "," (V.toList $ pretty <$> es) + pretty (OptionVal _ (Just e)) = "Some" <+> pretty e + pretty (OptionVal _ Nothing) = "None" instance Show (E a) where show = show . pretty @@ -317,10 +341,10 @@ (==) (BBuiltin _ b) (BBuiltin _ b') = b == b' (==) (TBuiltin _ b) (TBuiltin _ b') = b == b' (==) (UBuiltin _ unOp) (UBuiltin _ unOp') = unOp == unOp' + (==) (NBuiltin _ x) (NBuiltin _ y) = x == y (==) (Tup _ es) (Tup _ es') = es == es' (==) (ResVar _ x) (ResVar _ y) = x == y (==) (Dfn _ f) (Dfn _ g) = f == g -- we're testing for lexical equivalence - (==) Ix{} Ix{} = True (==) RegexCompiled{} _ = error "Cannot compare compiled regex!" (==) _ RegexCompiled{} = error "Cannot compare compiled regex!" (==) (Paren _ e) e' = e == e' @@ -335,18 +359,23 @@ | Functor -- ^ For map (@"@) | Foldable | IsPrintf + | HasField Int (T K) -- TODO: witherable deriving (Eq, Ord) instance Pretty C where - pretty IsNum = "Num" - pretty IsEq = "Eq" - pretty IsOrd = "Ord" - pretty IsParseable = "Parseable" - pretty IsSemigroup = "Semigroup" - pretty Functor = "Functor" - pretty Foldable = "Foldable" - pretty IsPrintf = "Printf" + pretty IsNum = "Num" + pretty IsEq = "Eq" + pretty IsOrd = "Ord" + pretty IsParseable = "Parseable" + pretty IsSemigroup = "Semigroup" + pretty Functor = "Functor" + pretty Foldable = "Foldable" + pretty IsPrintf = "Printf" + pretty (HasField i ty) = "HasField" <+> pretty i <+> "~" <+> pretty ty + +instance Show C where + show = show . pretty -- decl data D a = SetFS BS.ByteString diff --git a/src/Jacinda/Backend/Normalize.hs b/src/Jacinda/Backend/Normalize.hs --- a/src/Jacinda/Backend/Normalize.hs +++ b/src/Jacinda/Backend/Normalize.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} + -- TODO: test this module? module Jacinda.Backend.Normalize ( compileR + , compileIn , eClosed , closedProgram , readDigits @@ -9,6 +12,8 @@ , mkStr , parseAsEInt , parseAsF + , the + , asTup ) where import Control.Monad.State.Strict (State, evalState, gets, modify) @@ -19,6 +24,7 @@ import qualified Data.IntMap as IM import Data.Semigroup ((<>)) import qualified Data.Vector as V +import Data.Word (Word8) import Intern.Name import Intern.Unique import Jacinda.AST @@ -26,6 +32,7 @@ import Jacinda.Regex import Jacinda.Rename import Jacinda.Ty.Const +import Regex.Rure (RureMatch (..)) mkI :: Integer -> E (T K) mkI = IntLit tyI @@ -56,16 +63,29 @@ f '9' = 9 f c = error (c:" is not a valid digit!") +the :: BS.ByteString -> Word8 +the bs = case BS.uncons bs of + Nothing -> error "Empty splitc char!" + Just (c,"") -> c + Just _ -> error "Splitc takes only one char!" + readFloat :: BS.ByteString -> Double readFloat = read . ASCII.unpack -- fill in regex with compiled. -compileR :: E (T K) - -> E (T K) +compileR :: E a + -> E a compileR = cata a where -- TODO: combine with eNorm pass? a (RegexLitF _ rr) = RegexCompiled (compileDefault rr) a x = embed x +compileIn :: Program a -> Program a +compileIn (Program ds e) = Program (compileD <$> ds) (compileR e) + +compileD :: D a -> D a +compileD d@SetFS{} = d +compileD (FunDecl n l e) = FunDecl n l (compileR e) + desugar :: a desugar = error "Should have been desugared by this stage." @@ -103,6 +123,30 @@ e' <- eNorm e modify (mapBinds (IM.insert i e')) +asTup :: Maybe RureMatch -> E (T K) +asTup Nothing = OptionVal undefined Nothing +asTup (Just (RureMatch s e)) = OptionVal undefined (Just $ Tup undefined (mkI . fromIntegral <$> [s, e])) + +applyUn :: E (T K) + -> E (T K) + -> EvalM (E (T K)) +applyUn unOp e = + case eLoc unOp of + TyArr _ _ res -> eNorm (EApp res unOp e) + _ -> error "Internal error?" + +applyOp :: E (T K) + -> E (T K) + -> E (T K) + -> EvalM (E (T K)) +applyOp op e e' = eNorm (EApp undefined (EApp undefined op e) e') -- TODO: undefined?? + +foldE :: E (T K) + -> E (T K) + -> V.Vector (E (T K)) + -> EvalM (E (T K)) +foldE op = V.foldM' (applyOp op) + -- TODO: equality on tuples, lists eNorm :: E (T K) -> EvalM (E (T K)) @@ -125,7 +169,7 @@ eNorm e@BBuiltin{} = pure e eNorm e@TBuiltin{} = pure e eNorm (Tup tys es) = Tup tys <$> traverse eNorm es -eNorm e@Ix{} = pure e +eNorm e@(NBuiltin _ Ix) = pure e eNorm (EApp ty op@BBuiltin{} e) = EApp ty op <$> eNorm e eNorm (EApp ty (EApp ty' op@(BBuiltin _ Matches) e) e') = do eI <- eNorm e @@ -145,7 +189,7 @@ eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (IntLit _ i, IntLit _ j) -> IntLit tyI (i+j) + (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i+j) _ -> EApp ty0 (EApp ty1 op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyStr) _) Plus) e) e') = do eI <- eNorm e @@ -158,32 +202,38 @@ eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (IntLit _ i, IntLit _ j) -> IntLit tyI (max i j) + (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (max i j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Min) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (IntLit _ i, IntLit _ j) -> IntLit tyI (min i j) + (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (min i j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Max) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (FloatLit _ x, FloatLit _ y) -> FloatLit tyF (max x y) + (FloatLit _ x, FloatLit _ y) -> x `seq` y `seq` FloatLit tyF (max x y) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Min) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (FloatLit _ x, FloatLit _ y) -> FloatLit tyF (min x y) + (FloatLit _ x, FloatLit _ y) -> x `seq` y `seq` FloatLit tyF (min x y) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin _ Split) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (StrLit l str, RegexCompiled re) -> let bss = splitBy re str in Arr l (StrLit l <$> bss) -- FIXME type of Arr (l) is wrong + (StrLit l str, RegexCompiled re) -> let bss = splitBy re str in Arr undefined (StrLit l <$> bss) _ -> EApp ty (EApp ty' op eI) eI' +eNorm (EApp ty (EApp ty' op@(BBuiltin _ Splitc) e) e') = do + eI <- eNorm e + eI' <- eNorm e' + pure $ case (eI, eI') of + (StrLit l str, StrLit _ c) -> let bss = BS.split (the c) str in Arr undefined (StrLit l <$> V.fromList bss) + _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty op@(UBuiltin _ Floor) e) = do eI <- eNorm e pure $ case eI of @@ -198,37 +248,37 @@ eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (IntLit _ i, IntLit _ j) -> IntLit tyI (i-j) + (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i-j) _ -> EApp ty0 (EApp ty1 op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Times) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (IntLit _ i, IntLit _ j) -> IntLit tyI (i*j) + (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i*j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Plus) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (FloatLit _ i, FloatLit _ j) -> FloatLit tyF (i+j) + (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i+j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Minus) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (FloatLit _ i, FloatLit _ j) -> FloatLit tyF (i-j) + (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i-j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Times) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (FloatLit _ i, FloatLit _ j) -> FloatLit tyF (i*j) + (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i*j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Div) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (FloatLit _ i, FloatLit _ j) -> FloatLit tyF (i/j) + (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i/j) _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (UBuiltin ty' Tally) e) = do eI <- eNorm e @@ -323,13 +373,13 @@ eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (BoolLit _ b, BoolLit _ b') -> BoolLit tyBool (b && b') + (BoolLit _ b, BoolLit _ b') -> b `seq` b' `seq` BoolLit tyBool (b && b') _ -> EApp ty0 (EApp ty1 op eI) eI' eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Or) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of - (BoolLit _ b, BoolLit _ b') -> BoolLit tyBool (b || b') + (BoolLit _ b, BoolLit _ b') -> b `seq` b' `seq` BoolLit tyBool (b || b') _ -> EApp ty0 (EApp ty1 op eI) eI' eNorm (EApp _ (EApp _ (UBuiltin _ Const) e) _) = eNorm e eNorm (EApp ty op@(UBuiltin _ Const) e) = EApp ty op <$> eNorm e @@ -338,6 +388,11 @@ pure $ case eI of (Arr _ es) -> es V.! (i-1) _ -> EApp ty op eI +eNorm (EApp ty op@(UBuiltin _ (Select i)) e) = do + eI <- eNorm e + pure $ case eI of + (Tup _ es) -> es !! (i-1) + _ -> EApp ty op eI eNorm (EApp ty op@(UBuiltin _ Not) e) = do eI <- eNorm e pure $ case eI of @@ -377,18 +432,59 @@ pure $ case (e0', e1', e2') of (StrLit _ str, IntLit _ i, IntLit _ j) -> mkStr (substr str (fromIntegral i) (fromIntegral j)) _ -> EApp ty0 (EApp ty1 (EApp ty2 (TBuiltin ty3 Substr) e0') e1') e2' +eNorm (EApp ty0 (EApp ty1 (EApp ty2 op@(TBuiltin _ Option) e0) e1) e2) = do + e0' <- eNorm e0 + e1' <- eNorm e1 + e2' <- eNorm e2 + case e2' of + (OptionVal _ Nothing) -> pure e0' + (OptionVal _ (Just e)) -> eNorm (EApp undefined e1' e) + _ -> pure $ EApp ty0 (EApp ty1 (EApp ty2 op e0') e1') e2' +eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Match) e) e') = do + eI <- eNorm e + eI' <- eNorm e' + pure $ case (eI, eI') of + (StrLit _ str, RegexCompiled re) -> asTup (find' re str) + _ -> EApp ty0 (EApp ty1 op eI) eI' eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Sprintf) e) e') = do eI <- eNorm e eI' <- eNorm e' - case (eI, eI') of - (StrLit _ fmt, _) | isReady eI' -> pure $ mkStr $ sprintf fmt eI' - _ -> EApp ty0 (EApp ty1 op eI) <$> eNorm e' + pure $ case (eI, eI') of + (StrLit _ fmt, _) | isReady eI' -> mkStr $ sprintf fmt eI' + _ -> EApp ty0 (EApp ty1 op eI) eI' +eNorm (EApp ty0 (EApp ty1 op@(BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyVec) _))) Map) x) y) = do + x' <- eNorm x + y' <- eNorm y + case y' of + Arr _ es -> Arr undefined <$> traverse (applyUn x') es -- TODO: undefined? + _ -> pure $ EApp ty0 (EApp ty1 op x') y' +eNorm (EApp ty0 (EApp ty1 (EApp ty2 op@(TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyVec) _) _))) Fold) f) x) y) = do + f' <- eNorm f + x' <- eNorm x + y' <- eNorm y + case y' of + Arr _ es -> foldE f' x' es + _ -> pure $ EApp ty0 (EApp ty1 (EApp ty2 op f') x') y' +-- eNorm (EApp ty0 (EApp ty1 op@(BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyVec) _))) Prior) x) y) = do + -- x' <- eNorm x + -- y' <- eNorm y + -- case y' of + -- Arr _ es -> Arr undefined <$> V.priorM (applyOp x') es + -- _ -> pure $ EApp ty0 (EApp ty1 op x') y' +-- eNorm (EApp ty0 (EApp ty1 (EApp ty2 op@(TBuiltin (TyArr _ _ (TyApp _ _ (TyApp _ (TyB _ TyVec) _))) ZipW) f) x) y) = do + -- f' <- eNorm f + -- x' <- eNorm x + -- y' <- eNorm y + -- case (x', y') of + -- (Arr _ es, Arr _ es') -> Arr undefined <$> V.zipWithM (applyOp f') es es' + -- _ -> pure $ EApp ty0 (EApp ty1 (EApp ty2 op f') x') y' eNorm (EApp ty0 (EApp ty1 (EApp ty2 op@TBuiltin{} f) x) y) = EApp ty0 <$> (EApp ty1 <$> (EApp ty2 op <$> eNorm f) <*> eNorm x) <*> eNorm y -eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Prior) x) y) = EApp ty0 <$> (EApp ty1 op <$> eNorm x) <*> eNorm y eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Map) x) y) = EApp ty0 <$> (EApp ty1 op <$> eNorm x) <*> eNorm y +eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Prior) x) y) = EApp ty0 <$> (EApp ty1 op <$> eNorm x) <*> eNorm y eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Filter) x) y) = EApp ty0 <$> (EApp ty1 op <$> eNorm x) <*> eNorm y -- FIXME: this will almost surely run into trouble; if the above pattern matches -- are not complete it will bottom! eNorm (EApp ty e@EApp{} e') = eNorm =<< (EApp ty <$> eNorm e <*> pure e') eNorm (Arr ty es) = Arr ty <$> traverse eNorm es +eNorm (OptionVal ty e) = OptionVal ty <$> traverse eNorm e diff --git a/src/Jacinda/Backend/Printf.hs b/src/Jacinda/Backend/Printf.hs --- a/src/Jacinda/Backend/Printf.hs +++ b/src/Jacinda/Backend/Printf.hs @@ -5,6 +5,7 @@ ) where import qualified Data.ByteString as BS +import Data.Semigroup ((<>)) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Jacinda.AST diff --git a/src/Jacinda/Backend/TreeWalk.hs b/src/Jacinda/Backend/TreeWalk.hs --- a/src/Jacinda/Backend/TreeWalk.hs +++ b/src/Jacinda/Backend/TreeWalk.hs @@ -58,6 +58,10 @@ asRegex (RegexCompiled re) = re asRegex _ = noRes +asArr :: E a -> V.Vector (E a) +asArr (Arr _ es) = es +asArr _ = noRes + -- TODO: do I want to interleave state w/ eNorm or w/e -- eval @@ -75,7 +79,7 @@ go op@UBuiltin{} = op go op@TBuiltin{} = op go (EApp ty op@BBuiltin{} e) = EApp ty op (go e) - go Ix{} = mkI (fromIntegral ix) + go (NBuiltin _ Ix) = mkI (fromIntegral ix) go AllField{} = StrLit tyStr line go (Field _ i) = StrLit tyStr (ctx ! (i-1)) -- cause vector indexing starts at 0 go (EApp _ (UBuiltin _ IParse) e) = @@ -98,6 +102,10 @@ (RegexCompiled reϵ, StrLit _ strϵ) -> BoolLit tyBool (not $ isMatch' reϵ strϵ) (StrLit _ strϵ, RegexCompiled reϵ) -> BoolLit tyBool (not $ isMatch' reϵ strϵ) _ -> noRes + go (EApp _ (EApp _ (BBuiltin _ Match) e) e') = + let eI = asRegex (go e) + eI' = asStr (go e') + in asTup (find' eI eI') go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyInteger) _) Plus) e) e') = let eI = asInt (go e) eI' = asInt (go e') @@ -193,6 +201,11 @@ re = asRegex (go e') bss = splitBy re str in Arr undefined (StrLit undefined <$> bss) + go (EApp _ (EApp _ (BBuiltin _ Splitc) e) e') = + let str = asStr (go e) + c = the (asStr (go e')) + bss = BS.split c str + in Arr undefined (StrLit undefined <$> V.fromList bss) go (EApp _ (EApp _ (EApp _ (TBuiltin _ Substr) e0) e1) e2) = let eI0 = asStr (go e0) eI1 = asInt (go e1) @@ -222,10 +235,31 @@ in case eI of (Arr _ es) -> go (es V.! (i-1)) _ -> noRes + go (EApp _ (UBuiltin _ (Select i)) e) = + let eI = go e + in case eI of + (Tup _ es) -> go (es !! (i-1)) + _ -> noRes go (EApp _ (EApp _ (BBuiltin _ Sprintf) e) e') = let eI = asStr (go e) eI' = go e' in mkStr (sprintf eI eI') + go (OptionVal ty e) = + OptionVal ty (go <$> e) + go (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyVec) _))) Map) x) y) = + let x' = go x + y' = asArr (go y) + in Arr undefined (applyUn' x' <$> y') + where applyUn' :: E (T K) -> E (T K) -> E (T K) + applyUn' e e' = go (EApp undefined e e') + go (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyVec) _) _))) Fold) f) seed) xs) = + let f' = go f + seed' = go seed + xs' = asArr (go xs) + in foldE f' seed' xs' + where foldE op = V.foldl' (applyOp' op) + applyOp' op e e' = go (EApp undefined (EApp undefined op e) e') + go (Arr ty es) = Arr ty (go <$> es) applyOp :: Int -> E (T K) -- ^ Operator @@ -274,7 +308,7 @@ ir re i (EApp _ (EApp _ (BBuiltin _ Map) op) stream) = let op' = compileR op in fmap (applyUn i op') . ir re i stream ir re i (EApp _ (EApp _ (BBuiltin _ Filter) op) stream) = let op' = compileR op - in filter (\e -> asBool (eClosed i $ applyUn i op' e)) . ir re i stream + in filter (asBool . applyUn i op') . ir re i stream ir re i (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp i op) . ir re i stream ir re i (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream -> let @@ -304,7 +338,7 @@ -- evaluate something that has a fold nested in it eWith :: RurePtr -> Int -> E (T K) -> [BS.ByteString] -> E (T K) -eWith re i (EApp _ (EApp _ (EApp _ (TBuiltin _ Fold) op) seed) stream) = foldWithCtx re i op seed stream -- FIXME: only fold on streams!! +eWith re i (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = foldWithCtx re i op seed stream eWith re i (EApp ty e0 e1) = \bs -> eClosed i (EApp ty (eWith re i e0 bs) (eWith re i e1 bs)) eWith _ _ e@BBuiltin{} = const e eWith _ _ e@UBuiltin{} = const e @@ -325,7 +359,7 @@ -> Either StreamError ([BS.ByteString] -> IO ()) fileProcessor _ _ AllField{} = Left NakedField fileProcessor _ _ Field{} = Left NakedField -fileProcessor _ _ Ix{} = Left NakedField +fileProcessor _ _ (NBuiltin _ Ix) = Left NakedField fileProcessor _ _ AllColumn{} = Right $ \inp -> printStream $ fmap mkStr inp fileProcessor re _ (Column _ i) = Right $ \inp -> do @@ -341,7 +375,7 @@ printStream $ ir re i e inp fileProcessor re i e@(EApp _ (EApp _ (BBuiltin _ Filter) _) _) = Right $ \inp -> do printStream $ ir re i e inp -fileProcessor re i e@(EApp _ (EApp _ (BBuiltin _ Map) _) _) = Right $ \inp -> do +fileProcessor re i e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) Map) _) _) = Right $ \inp -> do printStream $ ir re i e inp fileProcessor re i e@(EApp _ (EApp _ (BBuiltin _ Prior) _) _) = Right $ \inp -> do printStream $ ir re i e inp diff --git a/src/Jacinda/File.hs b/src/Jacinda/File.hs --- a/src/Jacinda/File.hs +++ b/src/Jacinda/File.hs @@ -36,7 +36,7 @@ Left err -> throw err Right (ast, m) -> let (typed, i) = yeet $ runTypeM m (tyProgram ast) - in closedProgram i typed + in closedProgram i (compileIn typed) compileFS :: Maybe BS.ByteString -> RurePtr compileFS (Just bs) = compileDefault bs @@ -52,7 +52,8 @@ Right (ast, m) -> do (typed, i) <- yeetIO $ runTypeM m (tyProgram ast) cont <- yeetIO $ runJac (compileFS (cliFS <|> getFS ast)) i typed - cont $ concatMap BSL.toChunks (ASCIIL.lines contents) -- FIXME: "lines" discards empty... perhaps ok? + cont $ fmap BSL.toStrict (ASCIIL.lines contents) + -- see: BSL.split, BSL.splitWith runOnHandle :: BSL.ByteString -- ^ Program -> Maybe BS.ByteString -- ^ Field separator diff --git a/src/Jacinda/Lexer.x b/src/Jacinda/Lexer.x --- a/src/Jacinda/Lexer.x +++ b/src/Jacinda/Lexer.x @@ -6,7 +6,6 @@ , runAlex , runAlexSt , withAlexSt - , lexJac , freshName , AlexPosn (..) , Alex (..) @@ -20,6 +19,7 @@ import Control.Arrow ((&&&)) import Data.Bifunctor (first) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as ASCII import Data.Functor (($>)) @@ -27,7 +27,7 @@ import qualified Data.Map as M import Data.Semigroup ((<>)) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Intern.Name import Intern.Unique import Prettyprinter (Pretty (pretty), (<+>), colon, squotes) @@ -42,6 +42,12 @@ @follow_char = [$latin $digit \_] +$str_special = [\\\'] + +@escape_str = \\ [$str_special n] + +@string = \' ([^ $str_special] | @escape_str)* \' + @name = [a-z] @follow_char* @tyname = [A-Z] @follow_char* @@ -54,6 +60,8 @@ y { mkRes VarY } } + <0> "[" { mkSym LSqBracket `andBegin` dfn } -- FIXME: this doesn't allow nested + <0,dfn> { $white+ ; @@ -90,8 +98,7 @@ ")" { mkSym RParen } "{%" { mkSym LBracePercent } "{|" { mkSym LBraceBar } - "[" { mkSym LSqBracket `andBegin` dfn } - "]" { mkSym RSqBracket `andBegin` 0 } -- FIXME: this doesn't allow nested + "]" { mkSym RSqBracket `andBegin` 0 } "~" { mkSym Tilde } "!~" { mkSym NotMatchTok } "," { mkSym Comma } @@ -106,7 +113,7 @@ in { mkKw KwIn } let { mkKw KwLet } - val { mkKw KwVal } + val { mkKw KwVal } end { mkKw KwEnd } :set { mkKw KwSet } fn { mkKw KwFn } @@ -119,20 +126,24 @@ substr { mkBuiltin BuiltinSubstr } split { mkBuiltin BuiltinSplit } + splitc { mkBuiltin BuiltinSplitc } sprintf { mkBuiltin BuiltinSprintf } + option { mkBuiltin BuiltinOption } floor { mkBuiltin BuiltinFloor } ceil { mkBuiltin BuiltinCeil } + match { mkBuiltin BuiltinMatch } ":i" { mkBuiltin BuiltinIParse } ":f" { mkBuiltin BuiltinFParse } "#t" { tok (\p _ -> alex $ TokBool p True) } "#f" { tok (\p _ -> alex $ TokBool p False) } - + \$$digit+ { tok (\p s -> alex $ TokStreamLit p (read $ ASCII.unpack $ BSL.tail s)) } `$digit+ { tok (\p s -> alex $ TokFieldLit p (read $ ASCII.unpack $ BSL.tail s)) } "."$digit+ { tok (\p s -> alex $ TokAccess p (read $ ASCII.unpack $ ASCII.tail s)) } + "->"$digit+ { tok (\p s -> alex $ TokSelect p (read $ ASCII.unpack $ ASCII.drop 2 s)) } $digit+ { tok (\p s -> alex $ TokInt p (read $ ASCII.unpack s)) } _$digit+ { tok (\p s -> alex $ TokInt p (negate $ read $ ASCII.unpack $ BSL.tail s)) } @@ -141,7 +152,7 @@ -- TODO: allow chars to be escaped -- TODO: consider dropping this syntax for strings? - '[^']*' { tok (\p s -> alex $ TokStr p (BSL.init $ BSL.tail s)) } + @string { tok (\p s -> alex $ TokStr p (escReplace' $ BSL.init $ BSL.tail s)) } "/"[^\/]*"/" { tok (\p s -> alex $ TokRR p (BSL.init $ BSL.tail s)) } -- TODO: allow slashes that are escaped @@ -170,6 +181,16 @@ mkBuiltin = constructor TokBuiltin +escReplace' :: BSL.ByteString -> BS.ByteString +escReplace' = encodeUtf8 . escReplace . decodeUtf8 . BSL.toStrict + +-- this is inefficient but w/e +escReplace :: T.Text -> T.Text +escReplace = + T.replace "\\\"" "\"" + . T.replace "\\n" "\n" + . T.replace "\\$" "$" + mkText :: BSL.ByteString -> T.Text mkText = decodeUtf8 . BSL.toStrict @@ -312,18 +333,24 @@ | BuiltinFParse | BuiltinSubstr | BuiltinSplit + | BuiltinSplitc + | BuiltinOption | BuiltinSprintf | BuiltinFloor | BuiltinCeil + | BuiltinMatch instance Pretty Builtin where pretty BuiltinIParse = ":i" pretty BuiltinFParse = ":f" pretty BuiltinSubstr = "substr" pretty BuiltinSplit = "split" + pretty BuiltinOption = "option" + pretty BuiltinSplitc = "splitc" pretty BuiltinSprintf = "sprintf" pretty BuiltinFloor = "floor" pretty BuiltinCeil = "ceil" + pretty BuiltinMatch = "match" data Token a = EOF { loc :: a } | TokSym { loc :: a, _sym :: Sym } @@ -335,11 +362,12 @@ | TokInt { loc :: a, int :: Integer } | TokFloat { loc :: a, float :: Double } | TokBool { loc :: a, boolTok :: Bool } - | TokStr { loc :: a, strTok :: BSL.ByteString } + | TokStr { loc :: a, strTok :: BS.ByteString } | TokStreamLit { loc :: a, ix :: Int } | TokFieldLit { loc :: a, ix :: Int } | TokRR { loc :: a, rr :: BSL.ByteString } | TokAccess { loc :: a, ix :: Int } + | TokSelect { loc :: a, field :: Int } instance Pretty (Token a) where pretty EOF{} = "(eof)" @@ -349,7 +377,7 @@ pretty (TokBuiltin _ b) = "builtin" <+> squotes (pretty b) pretty (TokKeyword _ kw) = "keyword" <+> squotes (pretty kw) pretty (TokInt _ i) = pretty i - pretty (TokStr _ str) = squotes (pretty $ mkText str) + pretty (TokStr _ str) = squotes (pretty $ decodeUtf8 str) pretty (TokStreamLit _ i) = "$" <> pretty i pretty (TokFieldLit _ i) = "`" <> pretty i pretty (TokRR _ rr') = "/" <> pretty (mkText rr') <> "/" @@ -358,11 +386,12 @@ pretty (TokBool _ False) = "#f" pretty (TokAccess _ i) = "." <> pretty i pretty (TokFloat _ f) = pretty f + pretty (TokSelect _ i) = "->" <> pretty i freshName :: T.Text -> Alex (Name AlexPosn) freshName t = do pos <- get_pos - newIdentAlex pos t + newIdentAlex pos t newIdentAlex :: AlexPosn -> T.Text -> Alex (Name AlexPosn) newIdentAlex pos t = do @@ -377,16 +406,6 @@ Nothing -> let i = max' + 1 in let newName = Name t (Unique i) pos in ((i, M.insert t i names, IM.insert i newName uniqs), newName) - -loop :: Alex [Token AlexPosn] -loop = do - tok' <- alexMonadScan - case tok' of - EOF{} -> pure [] - _ -> (tok' :) <$> loop - -lexJac :: BSL.ByteString -> Either String [Token AlexPosn] -lexJac = flip runAlex loop runAlexSt :: BSL.ByteString -> Alex a -> Either String (AlexUserState, a) runAlexSt inp = withAlexSt inp alexInitUserState diff --git a/src/Jacinda/Parser.y b/src/Jacinda/Parser.y --- a/src/Jacinda/Parser.y +++ b/src/Jacinda/Parser.y @@ -51,6 +51,7 @@ exclamation { TokSym $$ Exclamation } backslashdot { TokSym $$ BackslashDot } at { $$@(TokAccess _ _) } + select { $$@(TokSelect _ _) } plus { TokSym $$ PlusTok } minus { TokSym $$ MinusTok } @@ -100,10 +101,13 @@ fs { TokResVar $$ VarFs } split { TokBuiltin $$ BuiltinSplit } + splitc { TokBuiltin $$ BuiltinSplitc } substr { TokBuiltin $$ BuiltinSubstr } sprintf { TokBuiltin $$ BuiltinSprintf } floor { TokBuiltin $$ BuiltinFloor } ceil { TokBuiltin $$ BuiltinCeil } + option { TokBuiltin $$ BuiltinOption } + match { TokBuiltin $$ BuiltinMatch } iParse { TokBuiltin $$ BuiltinIParse } fParse { TokBuiltin $$ BuiltinFParse } @@ -173,7 +177,7 @@ | intLit { IntLit (loc $1) (int $1) } | floatLit { FloatLit (loc $1) (float $1) } | boolLit { BoolLit (loc $1) (boolTok $1) } - | strLit { StrLit (loc $1) (BSL.toStrict $ strTok $1) } + | strLit { StrLit (loc $1) (strTok $1) } | column { Column (loc $1) (ix $1) } | field { Field (loc $1) (ix $1) } | allColumn { AllColumn $1 } @@ -211,13 +215,18 @@ | min { BBuiltin $1 Min } | max { BBuiltin $1 Max } | split { BBuiltin $1 Split } + | match { BBuiltin $1 Match } + | splitc { BBuiltin $1 Splitc } | substr { TBuiltin $1 Substr } | sprintf { BBuiltin $1 Sprintf } + | option { TBuiltin $1 Option } | floor { UBuiltin $1 Floor } | ceil { UBuiltin $1 Ceiling } - | ix { Ix $1 } + | ix { NBuiltin $1 Ix } | parens(at) { UBuiltin (loc $1) (At $ ix $1) } + | parens(select) { UBuiltin (loc $1) (Select $ field $1) } | E at { EApp (eLoc $1) (UBuiltin (loc $2) (At $ ix $2)) $1 } + | E select { EApp (eLoc $1) (UBuiltin (loc $2) (Select $ field $2)) $1 } | backslash name dot E { Lam $1 $2 $4 } | parens(E) { Paren (eLoc $1) $1 } diff --git a/src/Jacinda/Parser/Rewrite.hs b/src/Jacinda/Parser/Rewrite.hs --- a/src/Jacinda/Parser/Rewrite.hs +++ b/src/Jacinda/Parser/Rewrite.hs @@ -35,7 +35,11 @@ a (EAppF l e0@(BBuiltin _ Max) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(BBuiltin _ Min) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(BBuiltin _ Split) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 + a (EAppF l e0@(BBuiltin _ Match) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 + a (EAppF l e0@(BBuiltin _ Splitc) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(BBuiltin _ Sprintf) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(TBuiltin _ Substr) (EApp lϵ (EApp lϵϵ e1 e2) e3)) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 a (EAppF l e0@(TBuiltin _ Substr) (EApp lϵ e1 (EApp lϵϵ e2 e3))) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 + a (EAppF l e0@(TBuiltin _ Option) (EApp lϵ (EApp lϵϵ e1 e2) e3)) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 + a (EAppF l e0@(TBuiltin _ Option) (EApp lϵ e1 (EApp lϵϵ e2 e3))) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 a x = embed x diff --git a/src/Jacinda/Regex.hs b/src/Jacinda/Regex.hs --- a/src/Jacinda/Regex.hs +++ b/src/Jacinda/Regex.hs @@ -5,6 +5,7 @@ , splitWhitespace , defaultRurePtr , isMatch' + , find' , compileDefault , substr ) where @@ -15,7 +16,7 @@ import Data.Semigroup ((<>)) import qualified Data.Vector as V import Foreign.ForeignPtr (plusForeignPtr) -import Regex.Rure (RureMatch (..), RurePtr, compile, isMatch, matches, mkIter, rureDefaultFlags, rureFlagDotNL) +import Regex.Rure (RureMatch (..), RurePtr, compile, find, isMatch, matches, mkIter, rureDefaultFlags, rureFlagDotNL) import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) -- see: https://docs.rs/regex/latest/regex/#perl-character-classes-unicode-friendly @@ -33,8 +34,12 @@ splitWhitespace = splitBy defaultRurePtr substr :: BS.ByteString -> Int -> Int -> BS.ByteString -substr (BS.BS fp l) begin endϵ | endϵ >= begin = BS.BS (fp `plusForeignPtr` begin) ((min l endϵ)-begin) +substr (BS.BS fp l) begin endϵ | endϵ >= begin = BS.BS (fp `plusForeignPtr` begin) (min l endϵ - begin) | otherwise = "error: invalid substring indices." + +{-# NOINLINE find' #-} +find' :: RurePtr -> BS.ByteString -> Maybe RureMatch +find' re str = unsafeDupablePerformIO $ find re str 0 {-# NOINLINE splitBy #-} splitBy :: RurePtr diff --git a/src/Jacinda/Rename.hs b/src/Jacinda/Rename.hs --- a/src/Jacinda/Rename.hs +++ b/src/Jacinda/Rename.hs @@ -101,6 +101,8 @@ a DfnF{} = error "Not supported yet." a (LetF _ b e) = e || snd b a (GuardedF _ p b) = b || p + a (ImplicitF _ e) = e + a (ParenF _ e) = e a _ = False replaceXY :: (a -> Name a) -- ^ @x@ @@ -147,4 +149,6 @@ (n', modR) <- withName n Let l (n', eϵ') <$> withRenames modR (renameE e') renameE (Paren _ e) = renameE e +renameE (Arr l es) = Arr l <$> traverse renameE es +renameE (OptionVal l e) = OptionVal l <$> traverse renameE e renameE e = pure e -- literals &c. diff --git a/src/Jacinda/Ty.hs b/src/Jacinda/Ty.hs --- a/src/Jacinda/Ty.hs +++ b/src/Jacinda/Ty.hs @@ -11,7 +11,7 @@ import Control.Exception (Exception) import Control.Monad.Except (throwError) import Control.Monad.State.Strict (StateT, gets, runStateT) -import Data.Bifunctor (second) +import Data.Bifunctor (first, second) import Data.Foldable (traverse_) import Data.Functor (void, ($>)) import qualified Data.IntMap as IM @@ -20,6 +20,7 @@ import qualified Data.Set as S import qualified Data.Text as T import Data.Typeable (Typeable) +import Debug.Trace import Intern.Name import Intern.Unique import Jacinda.AST @@ -34,12 +35,12 @@ (<#>) x y = x <> hardline <> y data Error a = UnificationFailed a (T ()) (T ()) - | Doesn'tSatisfy (T ()) C + | Doesn'tSatisfy a (T ()) C | IllScoped a (Name a) instance Pretty a => Pretty (Error a) where pretty (UnificationFailed l ty ty') = pretty l <+> "could not unify type" <+> squotes (pretty ty) <+> "with" <+> squotes (pretty ty') - pretty (Doesn'tSatisfy ty c) = squotes (pretty ty) <+> "is not a member of class" <+> pretty c + pretty (Doesn'tSatisfy l ty c) = pretty l <+> squotes (pretty ty) <+> "is not a member of class" <+> pretty c pretty (IllScoped l n) = pretty l <+> squotes (pretty n) <+> "is not in scope." instance Pretty a => Show (Error a) where @@ -51,7 +52,7 @@ -- (after accumulating classVar membership...) data TyState a = TyState { maxU :: Int , kindEnv :: IM.IntMap K - , classVars :: IM.IntMap (S.Set C) + , classVars :: IM.IntMap (S.Set (C, a)) , varEnv :: IM.IntMap (T K) , constraints :: S.Set (a, T K, T K) } @@ -70,7 +71,7 @@ maxULens :: Lens' (TyState a) Int maxULens f s = fmap (\x -> s { maxU = x }) (f (maxU s)) -classVarsLens :: Lens' (TyState a) (IM.IntMap (S.Set C)) +classVarsLens :: Lens' (TyState a) (IM.IntMap (S.Set (C, a))) classVarsLens f s = fmap (\x -> s { classVars = x }) (f (classVars s)) varEnvLens :: Lens' (TyState a) (IM.IntMap (T K)) @@ -123,6 +124,9 @@ unifyMatch um ((_, TyVar _ (Name _ (Unique k) _), ty@(TyApp{})):tys) = IM.insert k ty <$> unifyPrep (IM.insert k ty um) tys unifyMatch um ((l, TyApp _ ty ty', TyApp _ ty'' ty'''):tys) = unifyPrep um ((l, ty, ty'') : (l, ty', ty''') : tys) unifyMatch um ((l, TyArr _ ty ty', TyArr _ ty'' ty'''):tys) = unifyPrep um ((l, ty, ty'') : (l, ty', ty''') : tys) +unifyMatch um ((l, ty@(TyTup _ tys), ty'@(TyTup _ tys')):tyss) + | length tys == length tys' = unifyPrep um (zip3 (repeat l) tys tys' ++ tyss) + | otherwise = throwError (UnificationFailed l (void ty) (void ty')) unifyMatch um ((_, TyVar _ n@(Name _ (Unique k) _), ty@(TyVar _ n')):tys) | n == n' = unifyPrep um tys -- a type variable is always equal to itself, don't bother inserting this! | otherwise = IM.insert k ty <$> unifyPrep (IM.insert k ty um) tys @@ -166,7 +170,7 @@ dummyName :: T.Text -> TypeM a (Name K) dummyName n = freshName n Star -addC :: Name a -> C -> IM.IntMap (S.Set C) -> IM.IntMap (S.Set C) +addC :: Ord a => Name b -> (C, a) -> IM.IntMap (S.Set (C, a)) -> IM.IntMap (S.Set (C, a)) addC (Name _ (Unique i) _) c = IM.alter (Just . go) i where go Nothing = S.singleton c go (Just cs) = S.insert c cs @@ -184,48 +188,58 @@ modifying constraintsLens (S.insert (l, ty, ty')) -- TODO: this will need some class context if we permit custom types (Optional) -checkType :: T b -> C -> TypeM a () -checkType TyVar{} _ = pure () -- TODO: I think this is right -checkType (TyB _ TyStr) IsSemigroup = pure () -checkType (TyB _ TyInteger) IsSemigroup = pure () -checkType (TyB _ TyInteger) IsNum = pure () -checkType (TyB _ TyInteger) IsOrd = pure () -checkType (TyB _ TyInteger) IsEq = pure () -checkType (TyB _ TyInteger) IsParseable = pure () -checkType (TyB _ TyFloat) IsParseable = pure () -checkType (TyB _ TyFloat) IsSemigroup = pure () -checkType (TyB _ TyFloat) IsNum = pure () -checkType (TyB _ TyFloat) IsOrd = pure () -checkType (TyB _ TyFloat) IsEq = pure () -checkType (TyB _ TyBool) IsEq = pure () -checkType (TyB _ TyStr) IsEq = pure () -checkType (TyTup _ tys) IsEq = traverse_ (`checkType` IsEq) tys -checkType (TyTup _ tys) IsOrd = traverse_ (`checkType` IsOrd) tys -checkType (TyApp _ (TyB _ TyVec) ty) IsEq = checkType ty IsEq -checkType ty@TyTup{} c@IsNum = throwError $ Doesn'tSatisfy (void ty) c -checkType ty@(TyB _ TyStr) c@IsNum = throwError $ Doesn'tSatisfy (void ty) c -checkType ty@(TyB _ TyBool) c@IsNum = throwError $ Doesn'tSatisfy (void ty) c -checkType ty@TyArr{} c = throwError $ Doesn'tSatisfy (void ty) c -checkType (TyB _ TyVec) Functor = pure () -checkType (TyB _ TyStream) Functor = pure () -checkType ty c@Functor = throwError $ Doesn'tSatisfy (void ty) c -checkType (TyB _ TyVec) Foldable = pure () -checkType (TyB _ TyStream) Foldable = pure () -checkType ty c@Foldable = throwError $ Doesn'tSatisfy (void ty) c -checkType (TyB _ TyStr) IsPrintf = pure () -checkType (TyB _ TyFloat) IsPrintf = pure () -checkType (TyB _ TyInteger) IsPrintf = pure () -checkType (TyB _ TyBool) IsPrintf = pure () -checkType (TyTup _ tys) IsPrintf = traverse_ (`checkType` IsPrintf) tys -checkType ty c@IsPrintf = throwError $ Doesn'tSatisfy (void ty) c +checkType :: Ord a => T K -> (C, a) -> TypeM a () +checkType TyVar{} _ = pure () -- TODO: I think this is right +checkType (TyB _ TyStr) (IsSemigroup, _) = pure () +checkType (TyB _ TyInteger) (IsSemigroup, _) = pure () +checkType (TyB _ TyInteger) (IsNum, _) = pure () +checkType (TyB _ TyInteger) (IsOrd, _) = pure () +checkType (TyB _ TyInteger) (IsEq, _) = pure () +checkType (TyB _ TyInteger) (IsParseable, _) = pure () +checkType (TyB _ TyFloat) (IsParseable, _) = pure () +checkType (TyB _ TyFloat) (IsSemigroup, _) = pure () +checkType (TyB _ TyFloat) (IsNum, _) = pure () +checkType (TyB _ TyFloat) (IsOrd, _) = pure () +checkType (TyB _ TyFloat) (IsEq, _) = pure () +checkType (TyB _ TyBool) (IsEq, _) = pure () +checkType (TyB _ TyStr) (IsEq, _) = pure () +checkType (TyTup _ tys) (IsEq, l) = traverse_ (`checkType` (IsEq, l)) tys +checkType (TyTup _ tys) (IsOrd, l) = traverse_ (`checkType` (IsOrd, l)) tys +checkType (TyApp _ (TyB _ TyVec) ty) (IsEq, l) = checkType ty (IsEq, l) +checkType ty@TyTup{} (c@IsNum, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType ty@(TyB _ TyStr) (c@IsNum, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType ty@(TyB _ TyBool) (c@IsNum, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType ty@TyArr{} (c, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType (TyB _ TyVec) (Functor, _) = pure () +checkType (TyB _ TyStream) (Functor, _) = pure () +checkType ty (c@Functor, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType (TyB _ TyVec) (Foldable, _) = pure () +checkType (TyB _ TyStream) (Foldable, _) = pure () +checkType ty (c@Foldable, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType (TyB _ TyStr) (IsPrintf, _) = pure () +checkType (TyB _ TyFloat) (IsPrintf, _) = pure () +checkType (TyB _ TyInteger) (IsPrintf, _) = pure () +checkType (TyB _ TyBool) (IsPrintf, _) = pure () +checkType (TyTup _ tys) (IsPrintf, l) = traverse_ (`checkType` (IsPrintf, l)) tys +checkType ty (c@IsPrintf, l) = throwError $ Doesn'tSatisfy l (void ty) c +checkType ty@(TyTup _ tys) (c@(HasField i ty'), l) | length tys >= i = pushConstraint l ty' (tys !! (i-1)) + | otherwise = throwError $ Doesn'tSatisfy l (void ty) c +checkType ty (c@HasField{}, l) = throwError $ Doesn'tSatisfy l (void ty) c -checkClass :: IM.IntMap (T K) -- ^ Unification result +substC :: IM.IntMap (T K) -- ^ Unification result + -> C + -> C +substC um (HasField i ty) = HasField i (substConstraints um ty) +substC _ c = c + +checkClass :: Ord a + => IM.IntMap (T K) -- ^ Unification result -> Int - -> S.Set C + -> S.Set (C, a) -> TypeM a () checkClass tys i cs = case substInt tys i of - Just ty -> traverse_ (checkType ty) (S.toList cs) + Just ty -> traverse_ (checkType ty) (first (substC tys) <$> S.toList cs) Nothing -> pure () -- FIXME: do we need to check var is well-kinded for constraint? lookupVar :: Name a -> TypeM a (T K) @@ -254,7 +268,9 @@ backNames <- unifyM =<< gets constraints toCheck <- gets (IM.toList . classVars) traverse_ (uncurry (checkClass backNames)) toCheck - pure (fmap (substConstraints backNames) (Program ds' e')) + backNames' <- unifyM =<< gets constraints + -- FIXME: not sure if termination/whatever is guaranteed, need 2 think.. + pure (fmap (substConstraints backNames') (Program ds' e')) -- FIXME kind check tyE :: Ord a => E a -> TypeM a (E (T K)) @@ -265,39 +281,39 @@ traverse_ (uncurry (checkClass backNames)) toCheck pure (fmap (substConstraints backNames) e') -tyNumOp :: TypeM a (T K) -tyNumOp = do +tyNumOp :: Ord a => a -> TypeM a (T K) +tyNumOp l = do m <- dummyName "m" - modifying classVarsLens (addC m IsNum) + modifying classVarsLens (addC m (IsNum, l)) let m' = var m pure $ tyArr m' (tyArr m' m') -tySemiOp :: TypeM a (T K) -tySemiOp = do +tySemiOp :: Ord a => a -> TypeM a (T K) +tySemiOp l = do m <- dummyName "m" - modifying classVarsLens (addC m IsSemigroup) + modifying classVarsLens (addC m (IsSemigroup, l)) let m' = var m pure $ tyArr m' (tyArr m' m') -tyOrd :: TypeM a (T K) -tyOrd = do +tyOrd :: Ord a => a -> TypeM a (T K) +tyOrd l = do a <- dummyName "a" - modifying classVarsLens (addC a IsOrd) + modifying classVarsLens (addC a (IsOrd, l)) let a' = var a pure $ tyArr a' (tyArr a' tyBool) -tyEq :: TypeM a (T K) -tyEq = do +tyEq :: Ord a => a -> TypeM a (T K) +tyEq l = do a <- dummyName "a" - modifying classVarsLens (addC a IsEq) + modifying classVarsLens (addC a (IsEq, l)) let a' = var a pure $ tyArr a' (tyArr a' tyBool) -- min/max -tyM :: TypeM a (T K) -tyM = do +tyM :: Ord a => a -> TypeM a (T K) +tyM l = do a <- dummyName "a" - modifying classVarsLens (addC a IsOrd) + modifying classVarsLens (addC a (IsOrd, l)) let a' = var a pure $ tyArr a' (tyArr a' a') @@ -310,6 +326,9 @@ tyVec :: T K tyVec = TyB (KArr Star Star) TyVec +tyOpt :: T K -> T K +tyOpt = hkt (TyB (KArr Star Star) TyOption) + tyE0 :: Ord a => E a -> TypeM a (E (T K)) tyE0 (BoolLit _ b) = pure $ BoolLit tyBool b tyE0 (IntLit _ i) = pure $ IntLit tyI i @@ -322,19 +341,20 @@ tyE0 (Field _ i) = pure $ Field tyStr i tyE0 AllField{} = pure $ AllField tyStr tyE0 AllColumn{} = pure $ AllColumn (tyStream tyStr) -tyE0 Ix{} = pure $ Ix tyI -tyE0 (BBuiltin _ Plus) = BBuiltin <$> tySemiOp <*> pure Plus -tyE0 (BBuiltin _ Minus) = BBuiltin <$> tyNumOp <*> pure Minus -tyE0 (BBuiltin _ Times) = BBuiltin <$> tyNumOp <*> pure Times -tyE0 (BBuiltin _ Gt) = BBuiltin <$> tyOrd <*> pure Gt -tyE0 (BBuiltin _ Lt) = BBuiltin <$> tyOrd <*> pure Lt -tyE0 (BBuiltin _ Geq) = BBuiltin <$> tyOrd <*> pure Geq -tyE0 (BBuiltin _ Leq) = BBuiltin <$> tyOrd <*> pure Leq -tyE0 (BBuiltin _ Eq) = BBuiltin <$> tyEq <*> pure Eq -tyE0 (BBuiltin _ Neq) = BBuiltin <$> tyEq <*> pure Neq -tyE0 (BBuiltin _ Min) = BBuiltin <$> tyM <*> pure Min -tyE0 (BBuiltin _ Max) = BBuiltin <$> tyM <*> pure Max +tyE0 (NBuiltin _ Ix) = pure $ NBuiltin tyI Ix +tyE0 (BBuiltin l Plus) = BBuiltin <$> tySemiOp l <*> pure Plus +tyE0 (BBuiltin l Minus) = BBuiltin <$> tyNumOp l <*> pure Minus +tyE0 (BBuiltin l Times) = BBuiltin <$> tyNumOp l <*> pure Times +tyE0 (BBuiltin l Gt) = BBuiltin <$> tyOrd l <*> pure Gt +tyE0 (BBuiltin l Lt) = BBuiltin <$> tyOrd l <*> pure Lt +tyE0 (BBuiltin l Geq) = BBuiltin <$> tyOrd l <*> pure Geq +tyE0 (BBuiltin l Leq) = BBuiltin <$> tyOrd l <*> pure Leq +tyE0 (BBuiltin l Eq) = BBuiltin <$> tyEq l <*> pure Eq +tyE0 (BBuiltin l Neq) = BBuiltin <$> tyEq l <*> pure Neq +tyE0 (BBuiltin l Min) = BBuiltin <$> tyM l <*> pure Min +tyE0 (BBuiltin l Max) = BBuiltin <$> tyM l <*> pure Max tyE0 (BBuiltin _ Split) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (hkt tyVec tyStr))) Split +tyE0 (BBuiltin _ Splitc) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (hkt tyVec tyStr))) Splitc tyE0 (BBuiltin _ Matches) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr tyBool)) Matches tyE0 (BBuiltin _ NotMatches) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr tyBool)) NotMatches tyE0 (UBuiltin _ Tally) = pure $ UBuiltin (tyArr tyStr tyI) Tally @@ -342,21 +362,29 @@ tyE0 (UBuiltin _ Not) = pure $ UBuiltin (tyArr tyBool tyBool) Not tyE0 (BBuiltin _ And) = pure $ BBuiltin (tyArr tyBool (tyArr tyBool tyBool)) And tyE0 (BBuiltin _ Or) = pure $ BBuiltin (tyArr tyBool (tyArr tyBool tyBool)) Or +tyE0 (BBuiltin _ Match) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (tyOpt $ TyTup Star [tyI, tyI]))) Match tyE0 (TBuiltin _ Substr) = pure $ TBuiltin (tyArr tyStr (tyArr tyI (tyArr tyI tyStr))) Substr tyE0 (UBuiltin _ IParse) = pure $ UBuiltin (tyArr tyStr tyI) IParse tyE0 (UBuiltin _ FParse) = pure $ UBuiltin (tyArr tyStr tyF) FParse tyE0 (UBuiltin _ Floor) = pure $ UBuiltin (tyArr tyF tyI) Floor tyE0 (UBuiltin _ Ceiling) = pure $ UBuiltin (tyArr tyF tyI) Ceiling -tyE0 (BBuiltin _ Sprintf) = do +tyE0 (BBuiltin l Sprintf) = do a <- dummyName "a" let a' = var a - modifying classVarsLens (addC a IsPrintf) + modifying classVarsLens (addC a (IsPrintf, l)) pure $ BBuiltin (tyArr tyStr (tyArr a' tyStr)) Sprintf tyE0 (UBuiltin _ (At i)) = do a <- dummyName "a" let a' = var a tyV = hkt tyVec a' pure $ UBuiltin (tyArr tyV a') (At i) +tyE0 (UBuiltin l (Select i)) = do + a <- dummyName "a" + b <- dummyName "b" + let a' = var a + b' = var b + modifying classVarsLens (addC a (HasField i b', l)) + pure $ UBuiltin (tyArr a' b') (Select i) tyE0 (UBuiltin _ Const) = do a <- dummyName "a" b <- dummyName "b" @@ -369,7 +397,7 @@ let a' = var a fTy = tyArr (tyArr a' tyBool) (tyArr (tyStream a') (tyStream a')) pure $ BBuiltin fTy Filter -tyE0 (BBuiltin _ Map) = do +tyE0 (BBuiltin l Map) = do a <- dummyName "a" b <- dummyName "b" f <- higherOrder "f" @@ -377,10 +405,10 @@ b' = var b f' = var f fTy = tyArr (tyArr a' b') (tyArr (hkt f' a') (hkt f' b')) - modifying classVarsLens (addC f Functor) + modifying classVarsLens (addC f (Functor, l)) pure $ BBuiltin fTy Map -- (b -> a -> b) -> b -> Stream a -> b -tyE0 (TBuiltin _ Fold) = do +tyE0 (TBuiltin l Fold) = do b <- dummyName "b" a <- dummyName "a" f <- higherOrder "f" @@ -388,7 +416,7 @@ a' = var a f' = var f fTy = tyArr (tyArr b' (tyArr a' b')) (tyArr b' (tyArr (hkt f' a') b')) - modifying classVarsLens (addC f Foldable) + modifying classVarsLens (addC f (Foldable, l)) pure $ TBuiltin fTy Fold -- (a -> a -> a) -> Stream a -> Stream a tyE0 (BBuiltin _ Prior) = do @@ -414,6 +442,13 @@ a' = var a fTy = tyArr (tyArr b' (tyArr a' b')) (tyArr b' (tyArr (tyStream a') (tyStream b'))) pure $ TBuiltin fTy Scan +tyE0 (TBuiltin _ Option) = do + b <- dummyName "b" + a <- dummyName "a" + let b' = var b + a' = var a + fTy = tyArr b' (tyArr (tyArr a' b') (tyArr (tyOpt a') b')) + pure $ TBuiltin fTy Option tyE0 (Implicit _ e) = do e' <- tyE0 e pure $ Implicit (tyStream (eLoc e')) e' @@ -457,3 +492,10 @@ tyE0 (ResVar _ Y) = desugar tyE0 RegexCompiled{} = error "Regex should not be compiled at this stage." tyE0 Paren{} = desugar +tyE0 (OptionVal _ (Just e)) = do + e' <- tyE0 e + pure $ OptionVal (tyOpt $ eLoc e') (Just e') +tyE0 (OptionVal _ Nothing) = do + a <- dummyName "a" + let a' = var a + pure $ OptionVal (tyOpt a') Nothing diff --git a/test/examples/ab.jac b/test/examples/ab.jac new file mode 100644 --- /dev/null +++ b/test/examples/ab.jac @@ -0,0 +1,5 @@ +let + val asec := {`2 ~ /^[aA][0-9]+/}{1} + val bsec := {`2 ~ /^[bB][0-9]+/}{1} + val sum := [(+)|0 x] +in (sum asec . sum bsec) end diff --git a/test/examples/awkBook1.jac b/test/examples/awkBook1.jac new file mode 100644 --- /dev/null +++ b/test/examples/awkBook1.jac @@ -0,0 +1,2 @@ +{. TODO: maybe need parseable class? +{`3:i>0}{(`1.`2:f*`3:f)} diff --git a/test/examples/hadoop.jac b/test/examples/hadoop.jac new file mode 100644 --- /dev/null +++ b/test/examples/hadoop.jac @@ -0,0 +1,13 @@ +{. cat *.pgn | grep "Result" | awk ... +{. awk '{ split($0, a, "-"); res = substr(a[1], length(a[1]), 1); if (res == 1) white++; if (res == 0) black++; if (res == 2) draw++;} END { print white+black+draw, white, black, draw }' +{. cat *.pgn | grep "Result" | awk '{ split($0, a, "-"); res = substr(a[1], length(a[1]), 1); print $0, a[1], res;}' + +{. N.B. should be easier? count records/columns +{. awk '{games += $1; white += $2; black += $3; draw += $4; } END { print games, white, black, draw }' + +let + val l := [(+)|0 x] + val white := l {`1:i = 1}{1} + val black := l {`1:i = 0}{1} + val draw := l {`1:i = 2}{1} +in (white + black + draw . white . black . draw) end diff --git a/test/examples/line.jac b/test/examples/line.jac new file mode 100644 --- /dev/null +++ b/test/examples/line.jac @@ -0,0 +1,2 @@ +{. print all lines > 72 bytes +{#`0>72}{`0} diff --git a/test/examples/pop.jac b/test/examples/pop.jac new file mode 100644 --- /dev/null +++ b/test/examples/pop.jac @@ -0,0 +1,4 @@ +{. see test/examples/data/countries, awk book +let + val popBy := [(+)|0 {% x}{`3:i}] +in (popBy /Asia/ . popBy /Europe/) end diff --git a/test/examples/ty.jac b/test/examples/ty.jac new file mode 100644 --- /dev/null +++ b/test/examples/ty.jac @@ -0,0 +1,4 @@ +fn count(x) := + (+)|0 [:1"x; + +1