diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for htvm + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 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 General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is 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. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + 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. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + 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 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. Use with the GNU Affero General Public License. + + 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 Affero 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 special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU 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 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 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 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 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 . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + 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 GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/htvm.cabal b/htvm.cabal new file mode 100644 --- /dev/null +++ b/htvm.cabal @@ -0,0 +1,84 @@ +name: htvm +synopsis: TVM bindings. +description: + This library provides interface to TVM Runtime, and experimental + EDSL for building models with TVM. + +homepage: https://github.com/grwlf/htvm +version: 0.1.0.0 +license: GPL-3 +license-file: LICENSE +category: Machine Learning +author: Sergey Mironov +maintainer: grrwlf@gmail.com +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +library + build-depends: + base >=4.11 && <4.12 + , array + , Earley + , pretty-show + , recursion-schemes + , containers + , unordered-containers + , deriving-compat + , mtl + , text + , pretty-show + , process + , filepath + , bytestring + , directory + , temporary + hs-source-dirs: + src + default-language: + Haskell2010 + build-tools: + c2hs + ghc-options: + -fwarn-incomplete-patterns + extra-libraries: + tvm_runtime dl pthread + exposed-modules: + HTVM.EDSL.Types + , HTVM.EDSL.Monad + , HTVM.EDSL.Printer + , HTVM.EDSL.Build + , HTVM.EDSL + , HTVM.Runtime.FFI + , HTVM.Runtime + , HTVM.Prelude + , HTVM + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + test + ghc-options: -Wall + build-depends: + base >=4.7 && < 5 + , bytestring + , containers + , tasty + , tasty-hunit + , tasty-quickcheck + , recursion-schemes + , htvm + , QuickCheck + , directory + , temporary + , text + default-language: Haskell2010 + extra-libraries: + tvm_runtime dl pthread + ghc-options: + -Wall -Wno-unused-imports + +source-repository head + type: git + location: https://github.com/grwlf/htvm diff --git a/src/HTVM.hs b/src/HTVM.hs new file mode 100644 --- /dev/null +++ b/src/HTVM.hs @@ -0,0 +1,10 @@ +module HTVM ( + module HTVM.EDSL + , module HTVM.Runtime + , module HTVM + ) where + + +import HTVM.EDSL +import HTVM.Runtime + diff --git a/src/HTVM/EDSL.hs b/src/HTVM/EDSL.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/EDSL.hs @@ -0,0 +1,12 @@ +module HTVM.EDSL ( + module HTVM.EDSL.Types + , module HTVM.EDSL.Monad + , module HTVM.EDSL.Printer + , module HTVM.EDSL.Build + , module HTVM.EDSL + ) where + +import HTVM.EDSL.Types +import HTVM.EDSL.Monad +import HTVM.EDSL.Printer +import HTVM.EDSL.Build diff --git a/src/HTVM/EDSL/Build.hs b/src/HTVM/EDSL/Build.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/EDSL/Build.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE OverloadedStrings #-} +module HTVM.EDSL.Build where + +import Control.Monad(when) +import Data.Text(Text) +import Data.Text.IO(writeFile) +import System.FilePath(isAbsolute) +import System.Exit(ExitCode(..)) +import System.Process(readCreateProcess,readProcessWithExitCode,shell) +import System.IO (hPutStr,stdout,stderr) +import Prelude hiding(writeFile) + +import HTVM.Prelude +import HTVM.EDSL.Types +import HTVM.EDSL.Monad +import HTVM.EDSL.Printer + +-- | Takes C++ program and passes it through standalone formatter +prettyCpp :: Text -> IO Text +prettyCpp t = tpack <$> readCreateProcess (shell "clang-format") (tunpack t) + +dumpProgram :: FilePath -> ProgramSrc -> IO () +dumpProgram fp (ProgramSrc code) = do + writeFile fp =<< prettyCpp code + +data CompileConfig = CompileConfig { + cc_dump :: Maybe FilePath + , cc_copy_out :: Bool +} deriving(Read,Show,Eq,Ord) + +defaultConfig :: CompileConfig +defaultConfig = CompileConfig Nothing False + +-- | Compile TVM program, the binary will be placed to file @fp@ +compileProgram :: CompileConfig -> FilePath -> ProgramSrc -> IO ProgramBin +compileProgram cc fp src@(ProgramSrc code) = do + case (cc_dump cc) of + Just dfp -> do + dumpProgram dfp src + Nothing -> return () + {- traceM (tunpack code) -} + pcode <- tunpack <$> prettyCpp code + (ec,out,err) <- readProcessWithExitCode "g++" ["-std=c++14", "-x", "c++", "-", "-ltvm", "-o", fp] pcode + when (cc_copy_out cc) $ do + hPutStr stderr err + hPutStr stdout out + case ec of + ExitFailure ec -> do + fail $ "compileProgram failure\n" + <> "Failed program was:\n\n" <> unlines (map (\(a,b) -> b <> " " <> a) ((lines pcode)`zip`[show x | x<-[1..]])) <> "\n" + <> "Compiler error:\n\n" <> err + <> "Compiler exit code: " <> show ec <> "\n" + ExitSuccess -> do + return (ProgramBin fp) + + +-- | Compile TVM model, the binary will be placed to file @fp@ Return +-- `ModuleGen` object that captures its filepath and module expression +compileModuleGen :: CompileConfig -> FilePath -> ModuleGenSrc -> IO ModuleGen +compileModuleGen cc fp (ModuleGenSrc mod code) = do + ProgramBin fp <- compileProgram cc fp (ProgramSrc code) + return (ModuleGen fp mod) + +-- | Execute the Model generator, return the Assembly string, suitable for +-- `compileModel` +stage :: ModuleGen -> IO Assembly +stage (ModuleGen fp mod) = + let + exec_fp = if isAbsolute fp then fp else "./" <> fp + in do + (ec,out,err) <- readProcessWithExitCode exec_fp [] "" + hPutStr stderr err + case ec of + ExitFailure ec -> do + error $ "stage failed, exit code " <> show ec + ExitSuccess -> do + return (Assembly mod out) + +-- | Produce the model library from the Assembly, see `stage`. +-- Binary will be placed to output file @fp@ +compileModel :: FilePath -> Assembly -> IO ModuleLib +compileModel fp asm@(Assembly mod a) = do + (ec,out,err) <- readProcessWithExitCode "g++" ["-std=c++14", "-x", "assembler", "-shared", "-fPIC", "-o", fp, "-"] a + hPutStr stderr err + hPutStr stdout out + case ec of + ExitFailure ec -> do + error $ "compileModel failed, exit code " <> show ec + ExitSuccess -> do + return (ModuleLib fp mod) + +-- | Build TVM module @modname@ from EDSL definition. +-- This function executes @g++@ compiler and @clang-format@ pretty-printer. The +-- environment should contain all the settings required for including TVM +-- headers and linking with TVM library. +-- +-- In particular, consider reviewing the following variables: +-- - @PATH@ to contain paths to @g++@ and @clang-format@ binaries +-- - @C_INCLUDE_PATH@, @CPLUS_INCLUDE_PATH@ to contain path to folder with +-- TVM headers +-- - @LIBRARY_PATH@, @LD_LIBRARY_PATH@ to contain paths to folder with TVM +-- shared libraries +-- +buildModule :: CompileConfig -> FilePath -> Module -> IO ModuleLib +buildModule cc fp m = do + withTmpf "mgen" $ \fpath -> do + mgen <- compileModuleGen cc fpath (printModuleGen m) + asm <- stage mgen + compileModel fp asm + + +printFunction :: CompileConfig -> Function -> IO Text +printFunction cc f@(Function te) = do + withTmpf "printer" $ \f -> do + ProgramBin prg <- compileProgram cc f (printPrinter te) + let exec_fp = if isAbsolute prg then prg else "./" <> prg + (ec,out,err) <- readProcessWithExitCode exec_fp [] [] + case ec of + ExitFailure ec -> do + error $ "compileModel failed, exit code " <> show ec + ExitSuccess -> return (tpack out) + diff --git a/src/HTVM/EDSL/Monad.hs b/src/HTVM/EDSL/Monad.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/EDSL/Monad.hs @@ -0,0 +1,379 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +module HTVM.EDSL.Monad where + +import qualified Data.Text as Text + +import Control.Applicative +import Control.Monad +import Control.Monad.State +import Control.Monad.Trans +import Control.Monad.Identity +import Data.Maybe (fromMaybe,fromJust) +import Data.Text (Text) + +import HTVM.Prelude +import HTVM.EDSL.Types + +data ExprCtx = ExprCtx { + ec_expr :: Maybe Expr + } deriving(Show) + +initExprCtx = ExprCtx Nothing + +newtype ExprT m a = ExprT { unExprT :: StateT ExprCtx m a } + deriving(Functor,Applicative,Monad,MonadTrans) + +runExprT :: (Monad m) => ExprT m Expr -> m (Expr,ExprCtx) +runExprT e = flip runStateT initExprCtx $ unExprT e + +stageExpr :: (Monad m) => ExprT m Expr -> m Expr +stageExpr e = fst <$> runExprT e + + +data StmtCtx = StmtCtx { + sc_gen :: Integer + , sc_expr :: TenExpr -> TenExpr + } + +initStmtCtx = StmtCtx 0 id + +newtype StmtT m a = StmtT { unStmtT :: StateT StmtCtx m a } + deriving(Functor,Applicative,Monad,MonadTrans,MonadState StmtCtx,MonadIO) + +type Stmt a = StmtT Identity a + +name :: (Monad m) => Text -> m Name +name = return . Name + +fresh' :: (Monad m) => Text -> Text -> StmtT m Name +fresh' pref suff = StmtT $ state $ \s@StmtCtx{..} -> (Name $ wrap pref <> tshow sc_gen <> wrap suff, s{sc_gen = sc_gen+1}) + where + wrap x = if x == "" then x else x <> "_" + +-- | Generate new preffixed and suffixed names +freshP,freshS :: (Monad m) => Text -> StmtT m Name +freshP p = fresh' p "" +freshS s = fresh' "" s + +fresh :: (Monad m) => StmtT m Name +fresh = fresh' "" "" + +runStmtT :: (Monad m) => StmtCtx -> StmtT m a -> m (a,StmtCtx) +runStmtT ctx s = flip runStateT ctx $ unStmtT s + +scope :: (Monad m) => StmtT m TenExpr -> StmtT m TenExpr +scope m = do + ctx0 <- get + (te,ctx1) <- lift $ runStmtT initStmtCtx{sc_gen=(sc_gen ctx0)} m + put ctx0{sc_gen=sc_gen ctx1} + -- traceM $ ppShow $ (sc_expr ctx1) te + return $ (sc_expr ctx1) te + +stageTenExpr :: (Monad m) => StmtT m TenExpr -> m TenExpr +stageTenExpr s = stage <$> runStmtT initStmtCtx s where + stage (te,StmtCtx{..}) = sc_expr te + +stageFunction :: (Monad m) => StmtT m Function -> m Function +stageFunction fe = Function <$> stageTenExpr (unFunction <$> fe) + +-- | Returned module contains all its definitions. +-- FIXME: Encode self-contained Modules differently. +stageModuleT :: (Monad m) => StmtT m Module -> m Module +stageModuleT s = stage <$> runStmtT initStmtCtx s where + stage (Module funcs te,StmtCtx{..}) = Module funcs (sc_expr te) + +stageModule :: StmtT Identity Module -> Module +stageModule = runIdentity . stageModuleT + +data Tensor = Tensor TenExpr + deriving(Show,Read,Eq,Ord) + +assign_ :: (Monad m) => Pattern -> TenExpr -> StmtT m () +assign_ p te1 = do + modify $ \s -> s{sc_expr = \te -> (sc_expr s) (TenLet p te1 te)} + +assignN :: (Monad m) => (Name -> Pattern) -> Text -> TenExpr -> StmtT m TenExpr +assignN mkpat prefix te1 = do + n <- freshP prefix + assign_ (mkpat n) te1 + return (TenId n) + +class TensorLike a where + toTenExpr :: a -> TenExpr + toPattern :: Name -> Pattern + fromTenExpr :: TenExpr -> a + +instance TensorLike Tensor where toTenExpr (Tensor te) = te; fromTenExpr = Tensor; toPattern = PTensor + +assign :: forall m a . (TensorLike a, Monad m) => a -> StmtT m a +assign a = fromTenExpr <$> assignN (toPattern @a) "asgn" (toTenExpr a) + +newtype Function = Function { unFunction :: TenExpr } + deriving(Read,Show,Eq,Ord) + +data Module = Module { modFuncs :: [Function] , modExpr :: TenExpr } + deriving(Read,Show,Eq,Ord) + +data ModuleGenSrc = ModuleGenSrc Module Text + deriving(Show,Read,Eq,Ord) + +data ProgramSrc = ProgramSrc Text + deriving(Show,Read,Eq,Ord) + +data ProgramBin = ProgramBin FilePath + deriving(Show,Read,Eq,Ord) + +data ModuleGen = ModuleGen FilePath Module + deriving(Show,Read,Eq,Ord) + +data Assembly = Assembly Module String + deriving(Show,Read,Eq,Ord) + +data ModuleLib = ModuleLib FilePath Module + deriving(Show,Read,Eq,Ord) + +function :: (Monad m) => Text -> [Placeholder] -> ([Tensor] -> StmtT m Tensor) -> StmtT m Function +function n plh fbody = do + Function <$> do + (\x -> assign_ (PFunc (Name n)) x >> pure (TenId (Name n))) =<< do + scope $ do + plhs <- forM plh $ assignN PTensor "plh" . TenPlh + Tensor bres <- fbody (map Tensor plhs) + res <- assignN PTenTuple "res" (TenTuple (plhs <> [bres])) + modify $ \s -> s{sc_expr = \te -> TenDef n ((sc_expr s) te)} + return res + +data Tuple = Tuple TenExpr + deriving(Show,Read,Eq,Ord) + +instance TensorLike Tuple where toTenExpr (Tuple te) = te; fromTenExpr = Tuple; toPattern = PTenTuple + +batchCompute' :: ShapeExpr -> Name -> (Expr -> [Expr]) -> TenExpr +batchCompute' se nm body = TenCompute se (PAxis nm) (ETuple $ body (EId nm)) + +batchCompute :: (Monad m) => ShapeExpr -> (Expr -> [Expr]) -> StmtT m Tuple +batchCompute se tbody = do + axis <- freshP "bcomp" + assign (Tuple $ batchCompute' se axis tbody) + +compute :: (Monad m) => ShapeExpr -> (Expr -> Expr) -> StmtT m Tensor +compute se ebody = do + axis <- freshP "comp" + assign (Tensor $ flip TenSlice 0 $ batchCompute' se axis ((\x -> [x]) . ebody)) + +-- | Version of assign where the computation rule is specified for each +-- Tensor's item +-- compute :: (Monad m) => ShapeExpr -> ([Expr] -> Expr) -> StmtT m Tensor +-- compute se ebody = +-- let +-- dims = [0..(shapeDim se)-1] +-- in do +-- axis <- freshP "vars" +-- assign $ compute' (TenShape se) axis (\x -> ebody (map (EShapeSlice x) dims)) + +-- | Call a function +call :: TenFuncName -> [TenExpr] -> TenExpr +call fname args = TenCall fname (map TenArg args) + +ecall :: ExprFuncName -> [Expr] -> Expr +ecall nm args = ECall nm args + +dimvar :: (Monad m) => StmtT m DimExpr +dimvar = do + nm <- freshP "var" + assign_ (PVar nm) (TenDim (DimCtr $ n_get nm)) + return (DimId nm) + +shapevar :: (Monad m) => [DimExpr] -> StmtT m ShapeExpr +shapevar de = do + n <- assignN PShape "shape" (TenShape (foldr1 ShapeSum (map ShapeVector de))) + return (ShapeTen n) + +-- | FIXME: Module returned is only valid in the context of StmtT monad's state. +-- One should encode this fact in types +modul :: (Monad m) => [Function] -> StmtT m Module +modul fns = do + n <- assignN PFuncTuple "lib" (TenTuple (map unFunction fns)) + return $ Module fns n + +-- | FIXME: Convertion from TenExpr to Expr looks weitd. Rethink returning +-- expression from statement monad +axisId :: (Monad m) => Tensor -> Integer -> StmtT m IterVar +axisId (Tensor t) i = IterVar . (\(TenId n) -> EId n) <$> assignN PIterVar "axis" (TenCall TenAxisId [TenArg t, IntArg i]) + +data IterVar = IterVar Expr + deriving(Show,Read,Eq,Ord) + +-- | FIXME: Convertion from TenExpr to Expr looks weitd. Rethink returning +-- expression from statement monad +reduce_axis :: (Monad m) => (DimExpr,DimExpr) -> StmtT m IterVar +reduce_axis (a,b) = IterVar . (\(TenId n) -> EId n) <$> assignN PIterVar "reduce_axis" (TenCall TenReduceAxis [TenArg $ TenTuple [TenDim a, TenDim b]]) + +infixr 7 ! + +class Sliceable a b c | a->b, a->c where + (!) :: a -> b -> c + +instance Sliceable Tensor [Expr] Expr where + (!) :: Tensor -> [Expr] -> Expr + (!) (Tensor t) sl = ETenSlice t sl + +instance Sliceable Tuple Integer Tensor where + (!) :: Tuple -> Integer -> Tensor + (!) (Tuple t) sl = Tensor $ TenSlice t sl + +instance Sliceable ShapeExpr Integer Expr where + (!) :: ShapeExpr -> Integer -> Expr + (!) t sl = EShapeSlice t sl + +instance Sliceable Expr Integer Expr where + (!) :: Expr -> Integer -> Expr + (!) e i = ESlice e i + + +class HasDefault a where + def :: a + +{- + _____ ___ ____ ___ ____ _ _ _ +|_ _/ _ \| _ \_ _| | __ )(_)_ __ __| (_)_ __ __ _ ___ + | || | | | |_) | | | _ \| | '_ \ / _` | | '_ \ / _` / __| + | || |_| | __/| | | |_) | | | | | (_| | | | | | (_| \__ \ + |_| \___/|_| |___| |____/|_|_| |_|\__,_|_|_| |_|\__, |___/ + |___/ + +FIXME: Bindings are highly C++ - specific, rethink +-} + +op1 op (Tensor a) = Tensor $ TenCall (TenOp op) [TenArg a] +op2 op (Tensor a) (Tensor b) = Tensor $ TenCall (TenOp op) [TenArg a, TenArg b] + +elemwise1 op (Tensor a) = Tensor $ TenCall (TenElemwise op) [TenArg a] +elemwise2 op (Tensor a) (Tensor b) = Tensor $ TenCall (TenElemwise op) [TenArg a, TenArg b] + +instance Num Tensor where + (+) = op2 "+" + (-) = op2 "-" + (*) = op2 "*" + negate = op1 "-" + abs = elemwise1 "abs" + signum = elemwise1 "sign" + fromInteger = error "fromInteger is not implemented for Tensor" + +instance Fractional Tensor where + fromRational = error "fromRational is not implemented for Tensor" + (/) = op2 "/" + +instance Floating Tensor where + pi = error "pi is not defined for Tensor" {- we should know shape to actually define pi -} + exp = elemwise1 "exp" + log = elemwise1 "log" + sqrt = elemwise1 "sqrt" + (**) = elemwise2 "pow" + logBase = elemwise2 "logBase" + sin = elemwise1 "sin" + cos = elemwise1 "cos" + tan = elemwise1 "tan" + asin = elemwise1 "asin" + acos = elemwise1 "acos" + atan = elemwise1 "atan" + sinh = elemwise1 "sinh" + cosh = elemwise1 "cosh" + tanh = elemwise1 "tanh" + asinh = elemwise1 "asinh" + acosh = elemwise1 "acosh" + atanh = elemwise1 "atanh" + +esum :: (Expr,[Expr]) -> Expr +esum (a,rs) = ecall ExprSum [a, ETuple rs] + +data Conv2dArgs = Conv2dArgs { + conv2d_stride :: (Integer,Integer) + , conv2d_padding ::(Integer,Integer) + , conv2d_dilation :: (Integer,Integer) + , conv2d_type :: Type + , conv2d_name :: Text + } deriving(Read,Show,Eq,Ord) + +instance HasDefault Conv2dArgs where + def = Conv2dArgs (1,1) (1,1) (1,1) TypeFloat32 "conv2d" + +conv2d_nchw :: Tensor -> Tensor -> Conv2dArgs -> Tensor +conv2d_nchw (Tensor x) (Tensor k) Conv2dArgs{..} = + Tensor $ TenCall TenConv2d_NCHW [ + TenArg x, TenArg k, + TenArg $ TenDim $ DimConst $ fst conv2d_stride, + TenArg $ TenDim $ DimConst $ snd conv2d_stride, + TenArg $ TenDim $ DimConst $ fst conv2d_padding, + TenArg $ TenDim $ DimConst $ snd conv2d_padding, + StrArg conv2d_name + ] + +data PadArgs = PadArgs { + pad_before :: [Expr] + , pad_after :: [Expr] + , pad_value :: Expr + , pad_name :: Text + } deriving(Read,Show,Eq,Ord) + +instance HasDefault PadArgs where + def = PadArgs [] [] 0 "pad" + +pad :: Tensor -> PadArgs -> Tensor +pad (Tensor x) PadArgs{..} = + Tensor $ TenCall TenPad [ + TenArg x + , TenArg $ TenExpr $ ETuple pad_before + , TenArg $ TenExpr $ ETuple pad_after + , TenArg $ TenExpr $ pad_value + , StrArg pad_name + ] + +matmul :: Tensor -> Tensor -> Tensor +matmul (Tensor a) (Tensor b) = Tensor $ TenCall TenMatMul [TenArg a, TenArg b] + +sigmoid :: Tensor -> Tensor +sigmoid = elemwise1 "sigmoid" + +split :: Tensor -> [Integer] -> Integer -> Tuple +split (Tensor a) indices axis = Tuple $ TenCall TenSplit [TenArg a, IntsArg indices, IntArg axis] + +{- + ____ _ _ _ +/ ___| ___| |__ ___ __| |_ _| | ___ +\___ \ / __| '_ \ / _ \/ _` | | | | |/ _ \ + ___) | (__| | | | __/ (_| | |_| | | __/ +|____/ \___|_| |_|\___|\__,_|\__,_|_|\___| + + ____ _ _ _ +| __ )(_)_ __ __| (_)_ __ __ _ ___ +| _ \| | '_ \ / _` | | '_ \ / _` / __| +| |_) | | | | | (_| | | | | | (_| \__ \ +|____/|_|_| |_|\__,_|_|_| |_|\__, |___/ + |___/ + +-} + +data Schedule = Schedule TenExpr + deriving(Show,Read,Eq,Ord) + +instance TensorLike Schedule where toTenExpr (Schedule s) = s; fromTenExpr = Schedule; toPattern = PSchedule + +schedule :: (Monad m) => [Tensor] -> StmtT m Schedule +schedule ts = Schedule <$> assignN PSchedule "sched" (TenCall TenSchedule [TenArg $ TenTuple [t|Tensor t<-ts]]) + +parallel :: (Monad m) => Schedule -> Tensor -> IterVar -> StmtT m () +parallel (Schedule s) (Tensor t) (IterVar a) = + return () <* assignN PStage "stage" (TenCall TenParallel [TenArg s, TenArg t, TenArg $ TenExpr a]) + diff --git a/src/HTVM/EDSL/Printer.hs b/src/HTVM/EDSL/Printer.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/EDSL/Printer.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +module HTVM.EDSL.Printer where + +import qualified Data.Text as Text + +import Control.Monad.Writer(MonadWriter,Writer,tell,execWriter) +import Data.Monoid((<>)) +import Data.Maybe(fromJust) +import Data.Text(Text) + +import HTVM.Prelude +import HTVM.EDSL.Types +import HTVM.EDSL.Monad + +printDimExpr :: DimExpr -> Text +printDimExpr se = + let + go = printDimExpr + in + case se of + DimConst i -> tshow i + DimId n -> printName n + DimCall nm es + | isOpName nm && length es == 2 -> go (es!!0) <> printName nm <> go (es!!1) + | isOpName nm && length es == 1 -> printName nm <> go (es!!0) + | otherwise -> printName nm <> "(" <> Text.intercalate "," (map go es) <> ")" + DimCtr n -> "tvm::var(\"" <> n <> "\")" + +printShapeExpr :: ShapeExpr -> Text +printShapeExpr se = + let + go = printShapeExpr + in + case se of + ShapeTen te -> "htvm_shape("<> printTenExpr te <> ")" + ShapeVector de -> "{" <> printDimExpr de <> "}" + ShapeScalar -> "{}" + ShapeSum se1 se2 -> "htvm_shape_concat("<> go se1 <> "," <> go se2 <> ")" + +printExprFuncName :: ExprFuncName -> Text +printExprFuncName fn = + case fn of + ExprSum -> "tvm::sum" + ExprOp op -> op + ESigmoid -> "tvm::sigmoid" + +printExpr :: Expr -> Text +printExpr e = + let + go = printExpr + in + case e of + EId n -> printName n + EConst c -> + case c of + CInt i -> tshow i + CFloat32 f -> tshow f + ECall nm es -> + case nm of + ExprOp _ + | length es == 2 -> go (es!!0) <> printExprFuncName nm <> go (es!!1) + | length es == 1 -> printExprFuncName nm <> go (es!!0) + _ -> printExprFuncName nm <> "(" <> Text.intercalate "," (map go es) <> ")" + ETenSlice te es -> printTenExpr te <> "(" <> Text.intercalate "," (map go es) <> ")" + EShapeSlice se sl -> printShapeExpr se <> "[" <> tshow sl <> "]" + ESlice e i -> go e <> "[" <> tshow i <> "]" + ETuple es -> "{" <> Text.intercalate "," (map go es) <> "}" + +printName :: Name -> Text +printName (Name n) = n -- TODO: escape to make C-compatible + +isOpName :: Name -> Bool +isOpName (Name n) = n`Text.isInfixOf`"+-*/" + +printPattern :: Pattern -> Text +printPattern p = + case p of + PTensor n -> "tvm::Tensor " <> printName n + PShape n -> "tvm::Array " <> printName n + PVar n -> "tvm::Var " <> printName n + PIterVar n -> "tvm::IterVar " <> printName n + PFunc n -> "tvm::LoweredFunc " <> printName n + PAxis n -> "tvm::Array " <> printName n + PTenTuple n -> "tvm::Array " <> printName n + PFuncTuple n -> "tvm::Array " <> printName n + PSchedule n -> "tvm::Schedule " <> printName n + PStage n -> "tvm::Stage " <> printName n + +printType :: Type -> Text +printType t = + case t of + TypeFloat32 -> "tvm::Float(32)" + TypeInt32 -> "tvm::Int(32)" + TypeTensor _ _ -> "tvm::Tensor()" + +printTenFuncName :: TenFuncName -> Text +printTenFuncName fn = + case fn of + TenOp op -> op + TenReduceAxis -> "tvm::reduce_axis" + TenConv2d_NCHW -> "topi::conv2d_nchw" + TenPad -> "topi::pad" + TenSchedule -> "htvm_create_schedule" + TenParallel -> "htvm_parallel" + TenAxisId -> "htvm_axis_id" + TenMatMul -> "topi::matmul" + TenElemwise x -> "topi::"<>x + TenSplit -> "topi::split" + +printLayout :: Layout -> Text +printLayout l = + case l of + NCHW -> "NCHW" + NWCN -> "NWCN" + NHWC -> "NHWC" + +printTenExpr :: TenExpr -> Text +printTenExpr te = + let + go = printTenExpr + + parg arg = + case arg of + TenArg e -> go e + StrArg str -> "\"" <> str <> "\"" + TypeArg t -> printType t + IntArg i -> tshow i + IntsArg is -> "{" <> (Text.intercalate "," (map tshow is)) <> "}" + LayoutArg l -> printLayout l + in + case te of + TenPlh (n,ty,s) -> "tvm::placeholder(" <> printShapeExpr s <> "," <> printType ty <> ",\""<>n<>"\")" + TenId n -> printName n + TenLet pat e1@(TenLet _ _ _) e2 -> printPattern pat <> " = ({" <> go e1 <> "; });\n" <> go e2 + TenLet pat e1 e2 -> printPattern pat <> " = " <> go e1 <> ";\n" <> go e2 + -- TenAxis (a,b) -> --error "printTenExpr: Axis (aka `tvm::IterVar`) is not implemented" + -- "tvm::reduce_axis({ " <> printDimExpr a <> "," <> printDimExpr b <> "})" + TenTuple es -> "{" <> Text.intercalate ", " (map go es) <> "}" + TenSlice te i -> go te <> "[" <> tshow i <> "]" + TenDim s -> printDimExpr s + TenShape s -> printShapeExpr s + TenExpr e -> printExpr e + TenCompute sh p e -> "tvm::compute(" <> printShapeExpr sh <> ", tvm::FBatchCompute([=](" <> printPattern p <> ") { return tvm::Array(" <> printExpr e <> "); }))" + TenDef n te -> + execWriter $ do + line $ "({" + line $ "tvm::BuildConfig config = tvm::build_config();" + line $ "auto args = ({" <> go te <> "; });" + line $ "tvm::Schedule s = tvm::create_schedule({args[args.size()-1]->op});" + line $ "std::unordered_map binds;" + line $ "auto f = tvm::Array(args);" + line $ "auto lowered = tvm::lower(s, f, \"" <> n <> "\", binds, config);" + line $ "lowered[0];" + line $ "})" + TenCall nm es -> + case nm of + TenOp _ + | (length es == 2) -> parg (es!!0) <> printTenFuncName nm <> parg (es!!1) + | (length es == 1) -> printTenFuncName nm <> parg (es!!0) + _ -> printTenFuncName nm <> "(" <> Text.intercalate ", " (map parg es) <> ")" -- FIXME: attrs? + +line :: (MonadWriter Text m) => Text -> m () +line x = tell (x <> "\n") + + +printModule:: Module -> Text +printModule (Module _ te) = + execWriter $ do + line $ "({" + line $ "tvm::Array funcs = ({" <> printTenExpr te <> "; });" + line $ "tvm::BuildConfig config = tvm::build_config();" + line $ "auto target = tvm::Target::create(\"llvm\"); " + line $ "auto target_host = tvm::Target::create(\"llvm\");" + line $ "tvm::runtime::Module mod = tvm::build(funcs, target, target_host, config);" + line $ "mod;" + line $ "})" + +printIncludes :: Writer Text () +printIncludes = do + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + line $ "#include " + line $ "" + line $ + "static inline tvm::Array \ + \htvm_shape_concat(const tvm::Array &s1, const tvm::Array &s2) {\ + \\ + \ tvm::Array res(s1);\ + \ for(int i=0; i &arr) {\ + \ tvm::Array ops;\ + \ for(auto a : arr) { ops.push_back(a->op); }\ + \ return tvm::create_schedule(ops);\ + \}" + line $ "tvm::Stage htvm_parallel(tvm::Schedule s, tvm::Tensor t, tvm::IterVar i) { return s[t->op].parallel(i); }" + line $ "tvm::IterVar htvm_axis_id(tvm::Tensor t, int i) { return t->op->root_iter_vars()[i]; }" + line $ "tvm::Array htvm_shape(tvm::Tensor t) { return t->shape; }" + line $ "tvm::Array htvm_shape(tvm::Array t) { return t; }" + line $ "" + + +printModuleGen :: Module -> ModuleGenSrc +printModuleGen mod = + ModuleGenSrc mod $ execWriter $ do + printIncludes + line $ "int main()" + line $ "{" + line $ "auto mod = " <> printModule mod <> ";" + line $ "std::cout << mod->GetSource(\"asm\") << std::endl;" + line $ "}" + + +printPrinter :: TenExpr -> ProgramSrc +printPrinter te = + ProgramSrc $ execWriter $ do + printIncludes + line $ "int main()" + line $ "{" + line $ "auto te = ({" <> printTenExpr te <> "; });" + line $ "std::cout << te->body << std::endl;" + line $ "}" + + diff --git a/src/HTVM/EDSL/Types.hs b/src/HTVM/EDSL/Types.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/EDSL/Types.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +module HTVM.EDSL.Types where + +import Data.Monoid +import Data.Text(Text) + +-- | Name is the string convertable to valid C/C++ identifier +newtype Name = Name { n_get :: Text } + deriving(Show,Read,Ord,Eq,Semigroup,Monoid) + +data Const = + CInt Integer + | CFloat32 Float + deriving(Show,Read,Ord,Eq) + +-- | Dimention expression represents the length of the vectors, number of +-- rows/columns in a matrix, etc. Converts to `tvm::Var`. +data DimExpr = + DimConst Integer + | DimId Name + | DimCall Name [DimExpr] + | DimCtr Text -- ^ Dim constructor aka `tvm::var` + deriving(Show,Read,Ord,Eq) + +instance Num DimExpr where + (+) a b = DimCall (Name "+") [a,b] + (-) a b = DimCall (Name "-") [a,b] + (*) a b = DimCall (Name "*") [a,b] + negate a = DimCall (Name "-") [a] + abs = error "abs is undefined for DimExpr" + signum = error "signum is undefined for DimExpr" + fromInteger = DimConst + +-- -- | Axis represents iterator running through the range supplied. Equivalent of +-- -- `tvm::IterVar`. +-- data Axis = Axis Name (DimExpr,DimExpr) +-- deriving(Show,Read,Ord,Eq) + +-- | Shape expressions represents the shape of a tensor, i.e. the number and +-- size of its dimentions. Rough equivalent of `tvm::Array`. +data ShapeExpr = + ShapeTen TenExpr + -- ^ Shape extractor. Only valid for `TenPlh` , + -- `TenCompute` and `TenShape` itself. + | ShapeVector DimExpr -- ^ Vector has 1 dimention of some length. + | ShapeScalar -- ^ Scalar has 0 dimentions. + | ShapeSum ShapeExpr ShapeExpr + -- ^ Concatenation on shapes + deriving(Show,Read,Ord,Eq) + +-- | Return the number of dimentions of ShapeExpr which is always known at compile time. +-- TODO: Move to `Eval.hs` as a generic algorithm +-- shapeDim :: ShapeExpr -> Integer +-- shapeDim (ShapeTen ndim _) = ndim +-- shapeDim (ShapeVector _) = 1 +-- shapeDim (ShapeScalar) = 0 +-- shapeDim (ShapeSum se1 se2) = shapeDim se1 + shapeDim se2 + +instance Semigroup ShapeExpr where + (<>) a b = ShapeSum a b + +shape :: [DimExpr] -> ShapeExpr +shape des = undefined + +-- | Convert ShapeExpr in flattern form, where each list itme represents a +-- dimention, either of known size or unknown at compile time. Empty list +-- represents a shape of scalar. +-- FIXME: This function is impossible +-- shapeFlattern :: ShapeExpr -> [Either DimExpr Integer] +-- shapeFlattern sh = +-- case sh of +-- ShapeId 1 n -> [Left n] +-- ShapeId x n -> error "shapeFlattern: don't know how to represent multidimentional shape variables" +-- ShapeVector x -> [Right x] +-- ShapeScalar -> [] +-- ShapeSum a b -> shapeFlattern a <> shapeFlattern b + +data ExprFuncName = + ExprOp Text + | ExprSum + | ESigmoid + deriving(Show,Read,Ord,Eq) + +-- | Scalar expressions +data Expr = + EConst Const -- ^ A constant + | EId Name -- ^ A variable + -- | EShape ShapeExpr -- ^ A shape expression + | EShapeSlice ShapeExpr Integer + -- ^ Access a certain dimention of ShapeExpr + | ETenSlice TenExpr [Expr] -- ^ Accessing an individual element of a tensor + | ECall ExprFuncName [Expr]-- ^ Call of a function or an operator + | ESlice Expr Integer -- ^ Tuple slicing + | ETuple [Expr] -- ^ A tuple of expressions + deriving(Show,Read,Ord,Eq) + +instance Num Expr where + (+) a b = ECall (ExprOp "+") [a,b] + (-) a b = ECall (ExprOp "-") [a,b] + (*) a b = ECall (ExprOp "*") [a,b] + negate a = ECall (ExprOp "-") [a] + abs = error "abs is undefined" + signum = error "signum is undefined" + fromInteger = EConst . CInt + +data Type = + TypeFloat32 + | TypeInt32 + | TypeTensor Type ShapeExpr + deriving(Show,Read,Ord,Eq) + +float32 = TypeFloat32 + +-- | Common arguments to various functions +data Args = Args { + a_name :: Maybe Name + , a_shape :: Maybe ShapeExpr + , a_type :: Maybe Type + } deriving(Show,Read,Ord,Eq) + +nullArgs :: Args +nullArgs = Args Nothing Nothing Nothing + +-- | Pattern is a left-hand-side of assignments +-- FIXME: Separate type codes from Name binding +data Pattern = + PTensor Name -- ^ Tensor + | PShape Name -- ^ Array + | PVar Name -- ^ Var + | PIterVar Name -- ^ IterVar + | PFunc Name -- ^ LoweredFunc + | PAxis Name + | PTenTuple Name + | PFuncTuple Name + | PSchedule Name + | PStage Name + deriving(Show,Read,Ord,Eq) + +-- | List of valid Tensor-Expression level function names +data TenFuncName = + TenOp Text + | TenReduceAxis + | TenConv2d_NCHW + | TenPad + | TenSchedule + | TenParallel + | TenAxisId + | TenMatMul + | TenElemwise Text + | TenSplit + deriving(Show,Read,Ord,Eq) + +-- | `TenCall` receive arguments of the following kinds +data TenArg = + TenArg TenExpr -- ^ Ordinary argument, another `TenExpr` + | StrArg Text -- ^ String argument + | IntArg Integer -- ^ Integer argument TODO: remove? + | IntsArg [Integer] -- ^ Integer argument TODO: remove? + | TypeArg Type -- ^ Type argument + | LayoutArg Layout -- ^ Layout argument + deriving(Show,Read,Ord,Eq) + +-- | Convolution layout +data Layout = NCHW | NWCN | NHWC + deriving(Show,Read,Ord,Eq) + +-- | Tensor Expressions. Allow us to write code like +-- `Tensor a,b; Tensor c = a + b;` +-- +-- Notes: +-- * We don't keep Type as a part of TenExpr since in theory we shouldn't need +-- it (assuming the typechecker is present) +data TenExpr = + TenId Name + | TenPlh Placeholder + -- ^ Placeholder is a disting kind of TenExpr because it + -- refers `Type` and `ShapeExpr` which are not `TenExpr` + | TenTuple [TenExpr] + | TenSlice TenExpr Integer -- ^ Slice `TenTuple` + | TenDim DimExpr + | TenShape ShapeExpr + | TenExpr Expr + -- ^ We need TenExpr to encode `reduce_axis` results. It returns + -- sliceable expressions + | TenLet Pattern TenExpr TenExpr + | TenCompute ShapeExpr Pattern Expr + | TenDef Text TenExpr + -- ^ Name and Expression of function definition. + -- FIXME: TenDef would be redundant in the presence of + -- typechecker. + | TenCall { tc_fname::TenFuncName, tc_args::[TenArg] } + -- ^ Function call. + -- `tc_fname` is the name of a function. + -- `tc_args` is its arguments. + deriving(Show,Read,Ord,Eq) + + +type Placeholder = (Text,Type,ShapeExpr) + +-- pls_name :: Placeholder -> Name +-- pls_name (nm,_,_) = nm + +-- data Axis = Axis {aExpr :: TenExpr} +-- deriving(Read,Show,Eq,Ord) + + + + diff --git a/src/HTVM/Prelude.hs b/src/HTVM/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/Prelude.hs @@ -0,0 +1,39 @@ +module HTVM.Prelude + ( module HTVM.Prelude + , module Text.Show.Pretty + , module Debug.Trace + ) where + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text + +import Text.Show.Pretty(ppShow) +import Data.Text (Text) +import Debug.Trace (traceM, traceShowM) +import Data.Foldable (Foldable) +import System.Directory (getTemporaryDirectory) +import System.IO.Temp (withTempFile) +import System.IO (hClose) + +tshow :: (Show a) => a -> Text +tshow = Text.pack . show + +tpack :: String -> Text +tpack = Text.pack + +tunpack :: Text -> String +tunpack = Text.unpack + +tputStrLn :: Text -> IO () +tputStrLn = Text.putStrLn + +twriteFile :: String -> Text -> IO () +twriteFile s f = Text.writeFile s f + +ilength :: Foldable t => t a -> Integer +ilength = toInteger . length + +withTmpf :: String -> (FilePath -> IO x) -> IO x +withTmpf nm act = do + tmp <- getTemporaryDirectory + withTempFile tmp nm $ \x h -> hClose h >> act x diff --git a/src/HTVM/Runtime.hs b/src/HTVM/Runtime.hs new file mode 100644 --- /dev/null +++ b/src/HTVM/Runtime.hs @@ -0,0 +1,11 @@ +module HTVM.Runtime ( + module HTVM.Runtime.FFI + , module HTVM.Runtime + , module Data.Int + , module Data.Word + ) where + +import Data.Int (Int8,Int16,Int32,Int64) +import Data.Word (Word8,Word16,Word32,Word64) + +import HTVM.Runtime.FFI diff --git a/src/HTVM/Runtime/FFI.chs b/src/HTVM/Runtime/FFI.chs new file mode 100644 --- /dev/null +++ b/src/HTVM/Runtime/FFI.chs @@ -0,0 +1,416 @@ +-- | Module defines wrappers for DLPack messages which are used by TVM to pass +-- to/from models + +-- {-# OPTIONS_GHC -fwarn-unused-imports #-} +-- {-# OPTIONS_GHC -fwarn-missing-signatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE FlexibleContexts #-} + + +module HTVM.Runtime.FFI where + +import qualified Data.Array as Array + +import Control.Exception (Exception, throwIO) +import Control.Arrow ((***)) +import Control.Monad (forM_) +import Data.Array (Array(..)) +import Data.ByteString (ByteString,pack) +import Data.Word (Word8,Word16,Word32,Word64) +import Data.Int (Int8,Int16,Int32,Int64) +import Data.Bits (FiniteBits(..),(.&.),shiftR) +import Data.Tuple (swap) +import Data.Text (Text) +import Data.List (nub) +import Foreign (ForeignPtr, newForeignPtr, Ptr, Storable(..), alloca, + allocaArray, peek, plusPtr, poke, peekArray, pokeArray, + castPtr, advancePtr, malloc, mallocArray, FunPtr(..), free, + withForeignPtr, nullPtr) +import Foreign.C.Types (CInt, CLong) +import Foreign.C.String (CString, withCString, peekCAString) +import System.IO.Unsafe (unsafePerformIO) + +import HTVM.Prelude + + +-- | Errors raised by various functions from this module +data TVMError = + TVMAllocFailed Int + | TVMFreeFailed Int + | TVMModLoadFailed Int String + | TVMFuncLoadFailed Int String + | TVMFunCallFailed Int String + | TVMFunCallBadType Int + | TVMCopyFailed Int String + deriving(Show,Read,Ord,Eq) + +instance Exception TVMError + + +#include +#include + +{# enum DLDataTypeCode as TVMDataTypeCode {upcaseFirstLetter} deriving(Eq) #} +{# enum DLDeviceType as TVMDeviceType {upcaseFirstLetter} deriving(Eq) #} + +{# enum TVMDeviceExtType {upcaseFirstLetter} deriving(Eq) #} +{# enum TVMTypeCode {upcaseFirstLetter} deriving(Eq) #} + +instance Storable TVMTypeCode where + sizeOf _ = {# sizeof TVMTypeCode #} + alignment _ = {# alignof TVMTypeCode #} + peek pc = toEnum <$> peek (castPtr pc) + poke pc c = poke (castPtr pc) (fromEnum c) + +-- | Representation of tvm_index_t +type TVMShapeIndex = {# type tvm_index_t #} + +-- | Representation of device identifiers +type TVMDeviceId = Int + +data TVMContext + +instance Storable TVMContext where + sizeOf _ = {# sizeof TVMContext #} + alignment _ = {# alignof TVMContext #} + peek = error "peek undefined" + poke = error "poke undefined" + +-- | Tensor representation, see `DLTensor` +data TVMTensor_Repr + +instance Storable TVMTensor_Repr where + sizeOf _ = {# sizeof DLTensor #} + alignment _ = {# alignof DLTensor #} + peek = error "peek undefined" + poke = error "poke undefined" + +-- | Alias for `TVMArrayHandle` +type TVMArrayHandle = Ptr TVMTensor_Repr + +-- | Alias for pointer to `TVMArray` aka `DLTensor`. +type TVMTensor = ForeignPtr TVMTensor_Repr + +-- | Alias for `TVMStreamHandle`. Not supported via this FFI currently. +type TVMStreamHandle = Ptr () + +data TVMValue + +instance Storable TVMValue where + sizeOf _ = {# sizeof TVMValue #} + alignment _ = {# alignof TVMValue #} + peek = error "peek undefined" + poke = error "poke undefined" + +-- | Alias for void* used as Module handle +type TVMModule = Ptr () + +-- | Alias for void* used as Function handle +type TVMFunction = Ptr () + +setTensor :: TVMTensor -> Ptr TVMValue -> Ptr TVMTypeCode -> IO () +setTensor ft pv pc = do + withForeignPtr ft $ \pt -> do + poke pc KArrayHandle + {# set TVMValue.v_handle #} pv (castPtr pt) + +-- setStr :: String -> Ptr TVMValue -> Ptr TVMTypeCode -> IO () +-- setStr s pv pc = undefined + +foreign import ccall unsafe "c_runtime_api.h TVMArrayAlloc" + tvmArrayAlloc + :: Ptr TVMShapeIndex + -- shape + -> CInt -- ndim, + -> CInt -- dtype_code, + -> CInt -- dtype_bits, + -> CInt -- dtype_lanes, + -> CInt -- device_type, + -> CInt -- device_id, + -> Ptr TVMArrayHandle + -- DLTensor* out + -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h TVMArrayFree" + tvmArrayFree :: TVMArrayHandle -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h &TVMArrayFree" + tvmArrayFree_ :: FunPtr (TVMArrayHandle -> IO ()) + + +foreign import ccall unsafe "c_runtime_api.h TVMModLoadFromFile" + tvmModLoadFromFile :: CString -> CString -> Ptr TVMModule -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h TVMModFree" + tvmModFree :: TVMModule -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h TVMModGetFunction" + tvmModGetFunction :: TVMModule -> CString -> CInt -> Ptr TVMFunction -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h TVMFuncFree" + tvmFuncFree :: TVMFunction -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h TVMGetLastError" + tvmGetLastError :: IO CString + +foreign import ccall unsafe "c_runtime_api.h TVMFuncCall" + tvmFuncCall :: TVMFunction -> Ptr TVMValue -> Ptr TVMTypeCode -> CInt -> Ptr TVMValue -> Ptr TVMTypeCode -> IO CInt + +foreign import ccall unsafe "c_runtime_api.h TVMArrayCopyFromTo" + tvmArrayCopyFromTo :: TVMArrayHandle -> TVMArrayHandle -> TVMStreamHandle -> IO CInt + +class TVMIndex i where + tvmList :: i -> [Integer] + +instance TVMIndex Integer where tvmList a = [a] +instance TVMIndex (Integer,Integer) where tvmList (a,b) = [a,b] +instance TVMIndex (Integer,Integer,Integer) where tvmList (a,b,c) = [a,b,c] +instance TVMIndex (Integer,Integer,Integer,Integer) where tvmList (a,b,c,d) = [a,b,c,d] + +tvmIndexDims :: (TVMIndex i) => i -> Integer +tvmIndexDims = ilength . tvmList + +class TVMElemType e where + tvmTypeCode :: TVMDataTypeCode + tvmTypeBits :: Integer + -- | Make a parameter of type + tvmTypeLanes :: Integer + +instance TVMElemType Int32 where tvmTypeCode = KDLInt; tvmTypeBits = 32; tvmTypeLanes = 1 +instance TVMElemType Word32 where tvmTypeCode = KDLUInt; tvmTypeBits = 32; tvmTypeLanes = 1 +instance TVMElemType Float where tvmTypeCode = KDLFloat; tvmTypeBits = 32; tvmTypeLanes = 1 +instance TVMElemType Int64 where tvmTypeCode = KDLUInt; tvmTypeBits = 64; tvmTypeLanes = 1 +instance TVMElemType Word64 where tvmTypeCode = KDLUInt; tvmTypeBits = 64; tvmTypeLanes = 1 +instance TVMElemType Double where tvmTypeCode = KDLFloat; tvmTypeBits = 64; tvmTypeLanes = 1 + +-- | Data source. @d@ is type of data, @i@ is a type of index, @e@ is a type of element +class (TVMIndex i, TVMElemType e) => TVMData d i e | d -> i, d -> e where + tvmIShape :: d -> [Integer] + tvmIndex :: d -> i -> IO e + tvmPeek :: [Integer] -> Ptr e -> IO d + tvmPoke :: d -> Ptr e -> IO () + -- ^ Write the contents of data to dense memory area. + -- TODO: figure out the alignment restirctions. + +instance (Storable e, Array.Ix i, TVMIndex i, TVMElemType e) => TVMData (Array i e) i e where + tvmIShape = map (uncurry (-)) . uncurry zip . (tvmList *** tvmList) . Array.bounds + tvmIndex d i = pure $ d Array.! i + tvmPoke d ptr = pokeArray ptr (Array.elems d) + tvmPeek shape ptr = error "peek is undefined for Arrays" + +tvmIShape1 d = [ilength d] +tvmIndex1 l i = pure $ l !! (fromInteger i) +tvmPoke1 d ptr = pokeArray ptr d +tvmPeek1 [x] ptr = peekArray (fromInteger x) ptr +tvmPeek1 _ ptr = error "tvmPeek1 should be called with single-element shape" +instance TVMData [Int32] Integer Int32 where tvmIShape = tvmIShape1 ; tvmIndex = tvmIndex1; tvmPoke = tvmPoke1; tvmPeek = tvmPeek1 +instance TVMData [Word32] Integer Word32 where tvmIShape = tvmIShape1 ; tvmIndex = tvmIndex1; tvmPoke = tvmPoke1; tvmPeek = tvmPeek1 +instance TVMData [Float] Integer Float where tvmIShape = tvmIShape1 ; tvmIndex = tvmIndex1; tvmPoke = tvmPoke1; tvmPeek = tvmPeek1 +instance TVMData [Int64] Integer Int64 where tvmIShape = tvmIShape1 ; tvmIndex = tvmIndex1; tvmPoke = tvmPoke1; tvmPeek = tvmPeek1 +instance TVMData [Word64] Integer Word64 where tvmIShape = tvmIShape1 ; tvmIndex = tvmIndex1; tvmPoke = tvmPoke1; tvmPeek = tvmPeek1 +instance TVMData [Double] Integer Double where tvmIShape = tvmIShape1 ; tvmIndex = tvmIndex1; tvmPoke = tvmPoke1; tvmPeek = tvmPeek1 + +tvmIShape2 [] = [0,0] +tvmIShape2 d = [ilength d, ilength (head d)] +tvmIndex2 l (r,c) = pure $ l !! (fromInteger r) !! (fromInteger c) +tvmPoke2 d ptr + | length d == 0 = pokeArray ptr (concat d) + | length (nub (map length d)) == 1 = pokeArray ptr (concat d) + | otherwise = error "All elements should have the same length" +tvmPeek2 [0,0] ptr = pure [] +tvmPeek2 [x,y] ptr = group y <$> peekArray (fromInteger $ x*y) ptr where + group :: Integer -> [a] -> [[a]] + group _ [] = [] + group n l + | n > 0 = (take (fromInteger n) l) : (group n (drop (fromInteger n) l)) + | otherwise = error "Negative n" +tvmPeek2 x _ = error "tvmPeek2 should be called with 2-element shape" +instance TVMData [[Int32]] (Integer,Integer) Int32 where tvmIShape = tvmIShape2 ; tvmIndex = tvmIndex2; tvmPoke = tvmPoke2; tvmPeek = tvmPeek2 +instance TVMData [[Word32]] (Integer,Integer) Word32 where tvmIShape = tvmIShape2 ; tvmIndex = tvmIndex2; tvmPoke = tvmPoke2; tvmPeek = tvmPeek2 +instance TVMData [[Float]] (Integer,Integer) Float where tvmIShape = tvmIShape2 ; tvmIndex = tvmIndex2; tvmPoke = tvmPoke2; tvmPeek = tvmPeek2 +instance TVMData [[Int64]] (Integer,Integer) Int64 where tvmIShape = tvmIShape2 ; tvmIndex = tvmIndex2; tvmPoke = tvmPoke2; tvmPeek = tvmPeek2 +instance TVMData [[Word64]] (Integer,Integer) Word64 where tvmIShape = tvmIShape2 ; tvmIndex = tvmIndex2; tvmPoke = tvmPoke2; tvmPeek = tvmPeek2 +instance TVMData [[Double]] (Integer,Integer) Double where tvmIShape = tvmIShape2 ; tvmIndex = tvmIndex2; tvmPoke = tvmPoke2; tvmPeek = tvmPeek2 + +tvmDataShape :: (TVMData d i e) => d -> [Integer] +tvmDataShape = tvmIShape + +tvmDataNDim :: (TVMData d i e) => d -> Integer +tvmDataNDim = ilength . tvmDataShape + +toCInt :: (Integral x) => x -> CInt +toCInt = fromInteger . toInteger + +fromCInt :: (Integral x) => CInt -> x +fromCInt = fromInteger . toInteger + +tensorDevice :: TVMTensor -> TVMDeviceType +tensorDevice ft = unsafePerformIO $ do + withForeignPtr ft $ \pt -> do + (toEnum . fromCInt) <$> {# get DLTensor->ctx.device_type #} pt + +tensorNDim :: TVMTensor -> Integer +tensorNDim ft = unsafePerformIO $ do + withForeignPtr ft $ \pt -> do + toInteger <$> {# get DLTensor->ndim #} pt + +{- +tensorNDimM :: TVMTensor -> IO Integer +tensorNDimM ft = do + withForeignPtr ft $ \pt -> do + toInteger <$> {# get DLTensor->ndim #} pt +-} + +tensorShape :: TVMTensor -> [Integer] +tensorShape ft = unsafePerformIO $ do + withForeignPtr ft $ \pt -> do + map toInteger <$> do + peekArray (fromInteger $ tensorNDim ft) =<< {# get DLTensor->shape #} pt + +-- | Create new empty TVMTensor object. This object will be managed by Haskell +-- runtime which would call free when it decides to do so. +-- +-- FIXME: non-CPU devices will not work, see FIXME in `pokeTensor` +newEmptyTensor :: forall e . (TVMElemType e) + => [Integer] -- ^ Shape + -> TVMDeviceType -- ^ Device type (CPU|GPU|etc) + -> TVMDeviceId -- ^ Device ID + -> IO TVMTensor +newEmptyTensor shape dt did = + let + ndim = length shape + in do + alloca $ \pt -> do + allocaArray ndim $ \pshape -> do + pokeArray pshape (map (fromInteger . toInteger) shape) + r <- + tvmArrayAlloc + pshape + (fromInteger $ toInteger $ ndim) + (toCInt $ fromEnum $ tvmTypeCode @e) + (toCInt $ tvmTypeBits @e) + (toCInt $ tvmTypeLanes @e) + (toCInt $ fromEnum dt) + (toCInt $ did) pt + case r of + 0 -> peek pt >>= newForeignPtr tvmArrayFree_ + e -> throwIO (TVMAllocFailed (fromCInt e)) + +-- | Allocate new Tensor object +newTensor :: forall d i e . (TVMData d i e) + => d -- ^ TvmData tensor-like object + -> TVMDeviceType -- ^ Device type + -> TVMDeviceId -- ^ Device ID + -> IO TVMTensor +newTensor d dt did = do + ft <- newEmptyTensor @e (map fromInteger $ tvmDataShape d) dt did + withForeignPtr ft $ \pt -> do + pdata <- {# get DLTensor->data #} pt + tvmPoke d (castPtr pdata) + return ft + + +peekTensor :: forall d i e b . (TVMData d i e) + => TVMTensor -> IO d +peekTensor ft = do + withForeignPtr ft $ \pt -> do + case tensorDevice ft of + KDLCPU -> do + pdata <- {# get DLTensor->data #} pt + tvmPeek (tensorShape ft) (castPtr pdata) + x -> do + fail "Not implemented" + +pokeTensor :: forall d i e b . (TVMData d i e) + => TVMTensor -> d -> IO () +pokeTensor ft d = do + withForeignPtr ft $ \pt -> do + case tensorDevice ft of + KDLCPU -> do + pdata <- {# get DLTensor->data #} pt + {- FIXME: Use CopyFromBytes for non-CPU devices -} + tvmPoke d (castPtr pdata) + x -> do + fail "Not implemented" + + +tensorCopy :: TVMTensor -> TVMTensor -> IO () +tensorCopy dst src = do + withForeignPtr dst $ \pdst -> do + withForeignPtr src $ \psrc -> do + ret <- tvmArrayCopyFromTo psrc pdst nullPtr + case ret of + 0 -> return () + e -> do + str <- getLastError + throwIO (TVMCopyFailed (fromCInt e) str) + +-- | Return a string describing the last error issued by TVM runtime +getLastError :: IO String +getLastError = peekCAString =<< tvmGetLastError + +-- | Load module from dynamic library @modname@ and process it with a callback @func@ +withModule :: FilePath -> (TVMModule -> IO b) -> IO b +withModule modname func = + alloca $ \pmod -> do + withCString modname $ \cmodname -> do + withCString "so" $ \so -> do + r <- tvmModLoadFromFile cmodname so pmod + case r of + 0 -> do + m <- peek pmod + b <- func m + tvmModFree m + return b + err -> do + str <- getLastError + throwIO (TVMModLoadFailed (fromInteger $ toInteger err) str) + +-- | Load the function named @funcname@ from module @mod@, use it in callback @func@ +withFunction :: Text -> TVMModule -> (TVMFunction -> IO b) -> IO b +withFunction funcname mod func = + alloca $ \pfunc -> do + withCString (tunpack funcname) $ \cfuncname -> do + r <- tvmModGetFunction mod cfuncname 0 pfunc + case r of + 0 -> do + f <- peek pfunc + b <- func f + tvmFuncFree f + return b + err -> do + str <- getLastError + throwIO (TVMFuncLoadFailed (fromInteger $ toInteger err) str) + +-- | Call function @fun@ returning @ret@ with @args@ +-- +-- TODO: Process pvretcode +callTensorFunction :: TVMTensor -> TVMFunction -> [TVMTensor] -> IO () +callTensorFunction ret fun args = + let + nargs = length args + 1 {- Result is also counts -} + clen = toCInt nargs + in do + alloca $ \pvret -> do + alloca $ \pvretcode -> do + allocaArray nargs $ \pvargs -> do + allocaArray nargs $ \pvargcodes -> do + forM_ ((args<>[ret])`zip`[0..nargs-1]) $ \(farg,off) -> do + case off < length args of + True -> setTensor farg (advancePtr pvargs off) (advancePtr pvargcodes off) + False -> setTensor ret (advancePtr pvargs off) (advancePtr pvargcodes off) + r <- tvmFuncCall fun pvargs pvargcodes clen pvret pvretcode + case r of + 0 -> do + return () + x -> do + str <- getLastError + throwIO (TVMFunCallFailed (fromCInt x) str) + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,268 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +module Main where + +import Test.Tasty (TestTree, testGroup, defaultMain) +import Test.Tasty.HUnit (Assertion, HasCallStack, testCase, assertBool, assertEqual, (@?=)) +import Test.Tasty.QuickCheck (testProperty) +import Test.QuickCheck (property, conjoin, choose, suchThat, forAll, sublistOf, + label, classify, whenFail, counterexample, elements, + vectorOf, Gen, Testable, frequency, sized, Property, + arbitrary, Arbitrary, listOf) +import Test.QuickCheck.Monadic (forAllM, monadicIO, run, assert) + +import Control.Monad (when) +import Data.Functor.Foldable (Fix(..), Recursive(..), Corecursive(..)) +import Data.Maybe (fromMaybe) +import Data.Text (isInfixOf) +import Data.Monoid ((<>)) +import System.Directory (getTemporaryDirectory) +import System.IO.Temp (withTempFile) +import Prelude + +import HTVM.Prelude +import HTVM + +genTensorList1 :: (Arbitrary e) => Gen [e] +genTensorList1 = do + x <- choose (0,10) + vectorOf x $ arbitrary + +genTensorList2 :: (Arbitrary e) => Gen [[e]] +genTensorList2 = do + x <- choose (0,10) + y <- choose (0,10) + vectorOf x $ vectorOf y $ arbitrary + +genShape :: Gen [Integer] +genShape = do + ndim <- choose (0,4) + vectorOf ndim (choose (0,5)) + +withTestModule :: Stmt Function -> (ModuleLib -> IO b) -> IO b +withTestModule mf act = + withTmpf "htvm-test-module" $ \fp -> do + {- traceM $ "file: " <> fp -} + act =<< do + buildModule defaultConfig fp $ + stageModule $ do + f <- mf + modul [f] + + +class EpsilonEqual a where + epsilonEqual :: Rational -> a -> a -> Bool + +instance EpsilonEqual Float where epsilonEqual eps a b = abs (a - b) < fromRational eps +instance EpsilonEqual Double where epsilonEqual eps a b = abs (a - b) < fromRational eps +instance EpsilonEqual a => EpsilonEqual [a] where + epsilonEqual eps a b = + length a == length b && (all (uncurry (epsilonEqual eps)) (a`zip`b)) + +assertEpsilonEqual :: (EpsilonEqual a, HasCallStack) => String -> Rational -> a -> a -> Assertion +assertEpsilonEqual msg eps a b = assertBool msg (epsilonEqual eps a b) + +main :: IO () +main = defaultMain $ + testGroup "All" $ reverse [ + + testGroup "Uninitialized Tensor FFI should work" $ + let + go :: forall e . TVMElemType e => [Integer] -> IO () + go sh = do + a <- newEmptyTensor @e sh KDLCPU 0 + assertEqual "poke-peek-2" (tensorNDim a) (ilength sh) + assertEqual "poke-peek-1" (tensorShape a) sh + + gen :: forall e . TVMElemType e => Property + gen = forAll genShape $ monadicIO . run . go @e + in [ + testProperty "Int32" $ (gen @Int32) + , testProperty "Word32" $ (gen @Word32) + , testProperty "Float" $ (gen @Float) + , testProperty "Int64" $ (gen @Int64) + , testProperty "Word64" $ (gen @Word64) + , testProperty "Double" $ (gen @Double) + ] + + , testGroup "Initiallized Tensor FFI should work" $ + let + go :: forall d i e . (TVMData d i e, Eq e, Eq d, Show d) => d -> IO () + go l = do + a <- newTensor l KDLCPU 0 + assertEqual "poke-peek-1" (tensorNDim a) (tvmDataNDim l) + assertEqual "poke-peek-2" (tensorShape a) (tvmDataShape l) + l2 <- peekTensor a + assertEqual "poke-peek-3" l l2 + return () + + flatzero :: [[e]] -> [[e]] + flatzero x | length (concat x) == 0 = [] + | otherwise = x + + gen1 :: forall e i . (Eq e, Show e, TVMData [e] i e, Arbitrary e) => Property + gen1 = forAll (genTensorList1 @e) $ monadicIO . run . go + + gen2 :: forall e i . (Eq e, Show e, TVMData [[e]] i e, Arbitrary e) => Property + gen2 = forAll (genTensorList2 @e) $ monadicIO . run . go . flatzero + in [ + testProperty "[Int32]" $ (gen1 @Int32) + , testProperty "[Word32]" $ (gen1 @Word32) + , testProperty "[Float]" $ (gen1 @Float) + , testProperty "[Int64]" $ (gen1 @Int64) + , testProperty "[Word64]" $ (gen1 @Word64) + , testProperty "[Double]" $ (gen1 @Double) + , testProperty "[[Int32]]" $ (gen2 @Int32) + , testProperty "[[Word32]]" $ (gen2 @Word32) + , testProperty "[[Float]]" $ (gen2 @Float) + , testProperty "[[Int64]]" $ (gen2 @Int64) + , testProperty "[[Word64]]" $ (gen2 @Word64) + , testProperty "[[Double]]" $ (gen2 @Double) + ] + + , testGroup "Copy FFI should work for tensors" $ + let + go :: forall d i e . (TVMData d i e, Eq e, Eq d, Show d) => d -> IO () + go l = do + src <- newTensor l KDLCPU 0 + dst <- newEmptyTensor @e (tensorShape src) KDLCPU 0 + tensorCopy dst src + l2 <- peekTensor dst + assertEqual "copy-peek-1" l l2 + return () + + flatzero :: [[e]] -> [[e]] + flatzero x | length (concat x) == 0 = [] + | otherwise = x + + gen1 :: forall e i . (Eq e, Show e, TVMData [e] i e, Arbitrary e) => Property + gen1 = forAll (genTensorList1 @e) $ monadicIO . run . go + + gen2 :: forall e i . (Eq e, Show e, TVMData [[e]] i e, Arbitrary e) => Property + gen2 = forAll (genTensorList2 @e) $ monadicIO . run . go . flatzero + in [ + testProperty "[Int32]" $ (gen1 @Int32) + , testProperty "[Word32]" $ (gen1 @Word32) + , testProperty "[Float]" $ (gen1 @Float) + , testProperty "[Int64]" $ (gen1 @Int64) + , testProperty "[Word64]" $ (gen1 @Word64) + , testProperty "[Double]" $ (gen1 @Double) + , testProperty "[[Int32]]" $ (gen2 @Int32) + , testProperty "[[Word32]]" $ (gen2 @Word32) + , testProperty "[[Float]]" $ (gen2 @Float) + , testProperty "[[Int64]]" $ (gen2 @Int64) + , testProperty "[[Word64]]" $ (gen2 @Word64) + , testProperty "[[Double]]" $ (gen2 @Double) + ] + + , testCase "Compiler (g++ -ltvm) should be available" $ do + withTmpf "htvm-compiler-test" $ \x -> do + _ <- compileModuleGen defaultConfig x (ModuleGenSrc undefined "int main() { return 0; }") + return () + + , testCase "Pretty-printer (clang-format) should be available" $ do + _ <- prettyCpp "int main() { return 0; }" + return () + + , testCase "Function printer should work" $ + do + dump <- + printFunction defaultConfig =<< do + stageFunction $ do + s <- shapevar [10] + function "vecadd" [("A",float32,s),("B",float32,s)] $ \[a,b] -> do + compute s $ \e -> a![e!0] + b![e!0] + assertBool "dump should contain 'produce' keyword" $ isInfixOf "produce" dump + + , testCase "Simple model should work" $ + let + dim0 = 4 :: Integer + fname = "vecadd" + in do + withTestModule (do + s <- shapevar [fromInteger dim0] + function fname [("A",float32,s),("B",float32,s)] $ \[a,b] -> do + compute s $ \e -> a![e!0] + b![e!0] + ) $ + \(ModuleLib p _) -> do + withModule p $ \hmod -> do + withFunction fname hmod $ \fmod -> do + a <- newTensor @[Float] [1,2,3,4] KDLCPU 0 + b <- newTensor @[Float] [10,20,30,40] KDLCPU 0 + c <- newEmptyTensor @Float [dim0] KDLCPU 0 + callTensorFunction c fmod [a,b] + assertEqual "Simple model result" [11,22,33,44::Float] =<< peekTensor c + + , testCase "Reduce axis operation should compile" $ + + withTestModule (do + s <- shapevar [4] + function "reduce" [("A",float32,s)] $ \[a] -> do + IterVar r <- reduce_axis (0,3) + compute ShapeScalar $ \_ -> esum (a![r], [r]) + ) $ \_ -> return () + + , testCase "Conv2d operation should compile" $ + + withTestModule (do + sa <- shapevar [1,1,10,10] + sk <- shapevar [1,1,3,3] + function "reduce" [("A",float32,sa), ("k",float32,sk)] $ \[a,k] -> do + return $ conv2d_nchw a k def + ) $ \_ -> return () + + , testCase "Pad operation should compile" $ + + withTestModule (do + sa <- shapevar [1,1,10,10] + function "reduce" [("A",float32,sa) ] $ \[a] -> do + return $ pad a def{pad_value=33, pad_before=[2,2,2,2]} + ) $ \_ -> return () + + , testCase "Parallel schedule should compile" $ + + withTestModule (do + sa <- shapevar [1,1,10,10] + function "reduce" [("A",float32,sa) ] $ \[a] -> do + c <- assign $ pad a def{pad_value=33, pad_before=[2,2,2,2]} + r <- axisId c 0 + s <- schedule [c] + parallel s c r + return c + ) $ \_ -> return () + + , testCase "Sigmoid primitive should work" $ + + withTestModule (do + s <- shapevar [4] + function "sigmoid" [("A",float32,s)] $ \[a] -> do + c <- assign $ sigmoid a + return c + ) $ + \(ModuleLib p _) -> do + withModule p $ \hmod -> do + withFunction "sigmoid" hmod $ \fmod -> + let + inp = [1,2,3,4] :: [Float] + out = map (\x -> 1.0 / (1.0 + exp (- x))) inp + in do + a <- newTensor @[Float] [1,2,3,4] KDLCPU 0 + c <- newEmptyTensor @Float [4] KDLCPU 0 + callTensorFunction c fmod [a] + c_ <- peekTensor c + assertEpsilonEqual "Simple model result" 1e-5 out c_ + + , testCase "Split primitive should compile" $ + + withTestModule (do + sa <- shapevar [2,4] + function "reduce" [("A",float32,sa) ] $ \[a] -> do + c <- assign $ split a [1] 0 + return (c!0) + ) $ \_ -> return () + ] +