htvm (empty) → 0.1.0.0

raw patch · 14 files changed

+2474/−0 lines, 14 filesdep +Earleydep +QuickCheckdep +arraysetup-changed

Dependencies added: Earley, QuickCheck, array, base, bytestring, containers, deriving-compat, directory, filepath, htvm, mtl, pretty-show, process, recursion-schemes, tasty, tasty-hunit, tasty-quickcheck, temporary, text, unordered-containers

Files

• ChangeLog.md +5/−0
• LICENSE +674/−0
• Setup.hs +2/−0
• htvm.cabal +84/−0
• src/HTVM.hs +10/−0
• src/HTVM/EDSL.hs +12/−0
• src/HTVM/EDSL/Build.hs +122/−0
• src/HTVM/EDSL/Monad.hs +379/−0
• src/HTVM/EDSL/Printer.hs +243/−0
• src/HTVM/EDSL/Types.hs +209/−0
• src/HTVM/Prelude.hs +39/−0
• src/HTVM/Runtime.hs +11/−0
• src/HTVM/Runtime/FFI.chs +416/−0
• test/Main.hs +268/−0

@@ -0,0 +1,5 @@+# Revision history for htvm++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,674 @@+              GNU GENERAL PUBLIC LICENSE+                Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    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 <http://www.gnu.org/licenses/>.++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:++    <program>  Copyright (C) <year>  <name of author>+    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+<http://www.gnu.org/licenses/>.++  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+<http://www.gnu.org/philosophy/why-not-lgpl.html>.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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

@@ -0,0 +1,10 @@+module HTVM (+    module HTVM.EDSL+  , module HTVM.Runtime+  , module HTVM+  ) where+++import HTVM.EDSL+import HTVM.Runtime+

@@ -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

@@ -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)+

@@ -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])+

@@ -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<tvm::Expr> " <> printName n+    PVar n -> "tvm::Var " <> printName n+    PIterVar n -> "tvm::IterVar " <> printName n+    PFunc n -> "tvm::LoweredFunc " <> printName n+    PAxis n -> "tvm::Array<tvm::Var> " <> printName n+    PTenTuple n -> "tvm::Array<tvm::Tensor> " <> printName n+    PFuncTuple n -> "tvm::Array<tvm::LoweredFunc> " <> 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<tvm::Expr>(" <> 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<tvm::Tensor, tvm::Buffer> binds;"+        line $ "auto f = tvm::Array<tvm::Tensor>(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<tvm::LoweredFunc> 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 <iostream>"+    line $ "#include <random>"+    line $ "#include <iomanip>"+    line $ "#include <array>"+    line $ "#include <exception>"++    line $ "#include <tvm/tvm.h>"+    line $ "#include <tvm/operation.h>"+    line $ "#include <tvm/tensor.h>"+    line $ "#include <tvm/build_module.h>"+    line $ "#include <topi/broadcast.h>"+    line $ "#include <topi/nn.h>"+    line $ "#include <topi/elemwise.h>"+    line $ "#include <topi/transform.h>"+    line $ ""+    line $+        "static inline tvm::Array<tvm::Expr> \+        \htvm_shape_concat(const tvm::Array<tvm::Expr> &s1, const tvm::Array<tvm::Expr> &s2) {\+        \\+        \  tvm::Array<tvm::Expr> res(s1);\+        \  for(int i=0; i<s2.size(); i++) {\+        \    res.push_back(s2[i]);\+        \  }\+        \\+        \  return res;\+        \}"+    line $+        "tvm::Schedule \+        \htvm_create_schedule(const tvm::Array<tvm::Tensor> &arr) {\+        \  tvm::Array<tvm::Operation> 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<tvm::Expr> htvm_shape(tvm::Tensor t) { return t->shape; }"+    line $ "tvm::Array<tvm::Expr> htvm_shape(tvm::Array<tvm::Expr> 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 $ "}"++

@@ -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<Expr>`.+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<Expr>+  | 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)++++

@@ -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

@@ -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

@@ -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 <dlpack/dlpack.h>+#include <tvm/runtime/c_runtime_api.h>++{# 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)+

@@ -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 ()+    ]+