diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,188 @@
+# hevm changelog
+
+## 0.16 - 2018-09-19
+ - Move ethjet into hevm
+
+## [0.15] - 2018-05-09
+ - Fix SDIV/SMOD definitions for extreme case
+
+## [0.14.1] - 2018-04-17
+ - Improve PC display in TTY
+
+## [0.14] - 2018-03-08
+ - Implement STATICCALL
+
+## [0.13] - 2018-02-28
+ - Require specific block number for RPC debugging
+ - Implement RETURNDATACOPY and RETURNDATASIZE
+ - Fix bug where created contracts didn't get their balance
+
+## [0.12.3] - 2017-12-19
+ - More useful RPC debugging because we strip the entire BZZR metadata
+
+## [0.12.2] - 2017-12-17
+ - Experimental new ecrecover implementation via libethjet
+ - Correct error checking for setUp() invocations
+
+## [0.12.1] - 2017-11-28
+ - Test name regex matching via --match
+ - Fixed source map parsing bug when used with solc --optimize
+ - TTY: fix a padding-related display glitch
+
+## [0.12] - 2017-11-14
+ - Use 13 different environment variables to control block parameters
+   for unit testing, e.g. block number, timestamp, initial balance, etc.
+
+   Full list:
+
+     - `DAPP_TEST_ADDRESS`
+     - `DAPP_TEST_CALLER`
+     - `DAPP_TEST_ORIGIN`
+     - `DAPP_TEST_GAS_CREATE`
+     - `DAPP_TEST_GAS_CALL`
+     - `DAPP_TEST_BALANCE_CREATE`
+     - `DAPP_TEST_BALANCE_CALL`
+     - `DAPP_TEST_COINBASE`
+     - `DAPP_TEST_NUMBER`
+     - `DAPP_TEST_TIMESTAMP`
+     - `DAPP_TEST_GAS_LIMIT`
+     - `DAPP_TEST_GAS_PRICE`
+     - `DAPP_TEST_DIFFICULTY`
+
+## [0.11.5] - 2017-11-14
+ - Use --state with --exec --debug
+
+## [0.11.4] - 2017-11-12
+ - Fix bug when unit test contract has creations in constructor
+
+## [0.11.3] - 2017-11-08
+ - Fix array support in ABI module
+
+## [0.11.2] - 2017-11-04
+ - TTY: show a help bar with key bindings at the bottom
+
+## [0.11.1] - 2017-11-02
+ - TTY: fix a display glitch
+ - TTY: improve display of ABI hashes on the stack
+
+## [0.11] - 2017-10-31
+ - Add "hevm flatten" for Etherscan-ish source code concatenation
+ - Simplify code by removing concrete/symbolic machine abstraction
+
+## [0.10.9] - 2017-10-23
+ - Fix bugs in ABI formatting
+
+## [0.10.7] - 2017-10-19
+ - Fix library linking bug
+ - Fix gas consumption of DELEGATECALL
+ - Better error tracing
+ - Experimental "contract browser" (stupid list of addresses)
+
+## [0.10.6] - 2017-10-19
+ - Enable library linking for unit tests and debugger
+ - Use the same default gas/balance values as `ethrun`
+
+## [0.10.5] - 2017-10-17
+ - Better trace output including arguments and return values
+ - Proof of concept coverage analysis via `dapp-test --coverage`
+
+## [0.10] - 2017-10-10
+ - Enable new trace output by default for failing tests
+ - Exit with failure code from test runner when tests fail
+ - More fixes to improve Ethereum test suite compliance
+
+## [0.9.5] - 2017-10-06
+ - Prototype of new trace output with `hevm dapp-test --verbose`
+ - Nicer trace tree in the TTY debugger
+ - Many fixes to improve Ethereum test suite compliance
+
+## [0.9] - 2017-09-29
+ - Integrates with live chains via RPC (read-only)
+ - Exposes a special contract address with test-related functionality (time warp)
+
+## [0.8.5] - 2017-09-22
+ - Renames `hevm` from its maiden name `hsevm` :sparkles:
+
+## [0.8] - 2017-09-21
+ - Implements gas metering (Metropolis rules by default)
+ - Shows gas counter in the terminal interface
+ - Enables debugger for consensus test executions
+ - Consensus test runner script with HTML reporting
+ - Passes 564 of the `VMTests`; fails 115 (see [0.8 test report])
+ - Command line options for specifying initial gas amounts and balances
+ - Improved TTY UI layout
+
+## [0.7] - 2017-09-07
+ - Can save and load contract states to disk using a Git-backed store (only `--exec`)
+ - Can debug raw EVM bytecode using `exec --debug`
+ - Fixes `exec --value`
+ - Has smarter defaults for command line when running tests or debugging
+ - Fixes bug with `MSIZE` in `CALL` context
+
+## [0.6.5] - 2017-09-01
+ - Fixes `exec` with regards to exit codes and error messages
+
+## [0.6.1] - 2017-08-03
+ - TTY: Adds command `C-n` in TTY for "stepping over"
+
+## [0.6] - 2017-08-03
+ - TTY: Adds second line to stack entries with humanized formatting
+ - TTY: Gets rid of the separate log pane in favor of a unified trace pane
+
+## [0.5] - 2017-08-02
+ - TTY: Adds `p` command for stepping backwards
+ - Adds ability to track origins of stack and heap words
+ - Tracks Keccak preimage for words that come from the `SHA3` instruction
+
+## [0.4] - 2017-07-31
+ - Parallelizes unit test runner
+ - Improves speed by changing representation of memory
+ - Internal refactoring for future support of symbolic execution
+ - Adds logs to the trace pane
+
+## [0.3.2] - 2017-06-17
+ - Adds `REVERT` opcode
+ - Sets `TIMESTAMP` value to `1` in unit tests
+
+## [0.3.0] - 2017-06-14
+ - Reverts contract state after `CALL` fails
+ - Improves test runner console output
+
+## [0.2.0] - 2017-06-13
+ - Fixes bug in `CALL`
+
+## [0.1.0.1] - 2017-03-31
+ - Highlights Solidity exactly on character level
+ - Adds `N` command for stepping by Solidity source position instead of by opcode
+
+## 0.1.0.0 - 2017-03-29
+ - First release
+
+[0.8 test report]: https://hydra.dapp.tools/build/135/download/1/index.html
+
+[0.12]: https://github.com/dapphub/hevm/compare/0.11.5...0.12
+[0.11.5]: https://github.com/dapphub/hevm/compare/0.11.4...0.11.5
+[0.11.4]: https://github.com/dapphub/hevm/compare/0.11.3...0.11.4
+[0.11.3]: https://github.com/dapphub/hevm/compare/0.11.2...0.11.3
+[0.11.2]: https://github.com/dapphub/hevm/compare/0.11.1...0.11.2
+[0.11.1]: https://github.com/dapphub/hevm/compare/0.11...0.11.1
+[0.11]: https://github.com/dapphub/hevm/compare/0.10.9...0.11
+[0.10.9]: https://github.com/dapphub/hevm/compare/0.10.7...0.10.9
+[0.10.7]: https://github.com/dapphub/hevm/compare/0.10.6...0.10.7
+[0.10.6]: https://github.com/dapphub/hevm/compare/0.10.5...0.10.6
+[0.10.5]: https://github.com/dapphub/hevm/compare/0.10...0.10.5
+[0.10]: https://github.com/dapphub/hevm/compare/0.9.5...0.10
+[0.9.5]: https://github.com/dapphub/hevm/compare/0.9...0.9.5
+[0.9]: https://github.com/dapphub/hevm/compare/v0.8.5...v0.9
+[0.8.5]: https://github.com/dapphub/hevm/compare/v0.8...v0.8.5
+[0.8]: https://github.com/dapphub/hevm/compare/v0.7...v0.8
+[0.7]: https://github.com/dapphub/hevm/compare/v0.6.5...v0.7
+[0.6.5]: https://github.com/dapphub/hevm/compare/v0.6.1...v0.6.5
+[0.6.1]: https://github.com/dapphub/hevm/compare/v0.6...v0.6.1
+[0.6]: https://github.com/dapphub/hevm/compare/v0.5...v0.6
+[0.5]: https://github.com/dapphub/hevm/compare/v0.4...v0.5
+[0.4]: https://github.com/dapphub/hevm/compare/v0.3.2...v0.4
+[0.3.2]: https://github.com/dapphub/hevm/compare/v0.3.0...v0.3.2
+[0.3.0]: https://github.com/dapphub/hevm/compare/v0.2.0...v0.3.0
+[0.2.0]: https://github.com/dapphub/hevm/compare/v0.1.0.1...v0.2.0
+[0.1.0.1]: https://github.com/dapphub/hevm/compare/v0.1.0.0...v0.1.0.1
diff --git a/COPYING b/COPYING
new file mode 100644
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,661 @@
+                    GNU AFFERO GENERAL PUBLIC LICENSE
+                       Version 3, 19 November 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <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 Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+  A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate.  Many developers of free software are heartened and
+encouraged by the resulting cooperation.  However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+  The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community.  It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server.  Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+  An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals.  This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing under
+this license.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU Affero General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Remote Network Interaction; Use with the GNU General Public License.
+
+  Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your version
+supports such interaction) an opportunity to receive the Corresponding
+Source of your version by providing access to the Corresponding Source
+from a network server at no charge, through some standard or customary
+means of facilitating copying of software.  This Corresponding Source
+shall include the Corresponding Source for any work covered by version 3
+of the GNU General Public License that is incorporated pursuant to the
+following paragraph.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU Affero General Public License from time to time.  Such new versions
+will be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <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 Affero General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Affero General Public License for more details.
+
+    You should have received a copy of the GNU Affero General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source.  For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code.  There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for the
+specific requirements.
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU AGPL, see
+<http://www.gnu.org/licenses/>.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/ethjet/ethjet.c b/ethjet/ethjet.c
new file mode 100644
--- /dev/null
+++ b/ethjet/ethjet.c
@@ -0,0 +1,110 @@
+#include "ethjet.h"
+#include "tinykeccak.h"
+
+#include <secp256k1_recovery.h>
+
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+
+struct ethjet_context *
+ethjet_init ()
+{
+  struct ethjet_context *ctx;
+  ctx = malloc (sizeof *ctx);
+  if (!ctx) return NULL;
+
+  ctx->ec = secp256k1_context_create (SECP256K1_CONTEXT_VERIFY);
+
+  return ctx;
+}
+
+void
+ethjet_free (struct ethjet_context *ctx)
+{
+  secp256k1_context_destroy (ctx->ec);
+  free (ctx);
+}
+
+/* 
+ * The example contract at 0xdeadbeef just reverses its input.
+ */
+int
+ethjet_example (struct ethjet_context *ctx,
+                uint8_t *in, size_t in_size,
+                uint8_t *out, size_t out_size)
+{
+  if (out_size != in_size)
+    return 0;
+
+  for (int i = 0; i < in_size; i++)
+    out[i] = in[in_size - i - 1];
+
+  return 1;
+}
+
+int
+ethjet_ecrecover (secp256k1_context *ctx,
+                  uint8_t *in, size_t in_size,
+                  uint8_t *out, size_t out_size)
+{
+  /* Input: H V R S, all 32 bytes. */
+
+  secp256k1_pubkey pubkey;
+  secp256k1_ecdsa_recoverable_signature rsig;
+
+  uint8_t *input64;
+  uint8_t pubkey_hex[65];
+  size_t hexlen = 65;
+
+  int recid;
+
+  if (in_size != 128)
+    return 0;
+
+  if (out_size != 32)
+    return 0;
+
+  input64 = in + 64;
+  recid = in[63] - 27;
+
+  if (recid < 0 || recid > 3)
+    return 0;
+
+  if (!secp256k1_ecdsa_recoverable_signature_parse_compact
+      (ctx, &rsig, input64, recid))
+    return 0;
+
+  if (!secp256k1_ecdsa_recover (ctx, &pubkey, &rsig, in))
+    return 0;
+
+  if (!secp256k1_ec_pubkey_serialize
+      (ctx, pubkey_hex, &hexlen, &pubkey, SECP256K1_EC_UNCOMPRESSED))
+    return 0;
+
+  if (sha3_256 (out, 32, pubkey_hex + 1, 64))
+    return 0;
+
+  memset (out, 0, 12);
+
+  return 1;
+}
+
+int
+ethjet (struct ethjet_context *ctx,
+        enum ethjet_operation op,
+        uint8_t *in, size_t in_size,
+        uint8_t *out, size_t out_size)
+{
+  switch (op) {
+  case ETHJET_ECRECOVER:
+    return ethjet_ecrecover (ctx->ec, in, in_size, out, out_size);
+    break;
+
+  case ETHJET_EXAMPLE:
+    return ethjet_example (ctx, in, in_size, out, out_size);
+
+  default:
+    return 0;
+  }
+}
diff --git a/ethjet/tinykeccak.c b/ethjet/tinykeccak.c
new file mode 100644
--- /dev/null
+++ b/ethjet/tinykeccak.c
@@ -0,0 +1,152 @@
+/** libkeccak-tiny
+*
+* A single-file implementation of SHA-3 and SHAKE.
+*
+* Implementor: David Leon Gil
+* License: CC0, attribution kindly requested. Blame taken too,
+* but not liability.
+*/
+
+#include "tinykeccak.h"
+
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+/******** The Keccak-f[1600] permutation ********/
+
+/*** Constants. ***/
+static const uint8_t rho[24] = \
+	{ 1,  3,   6, 10, 15, 21,
+	  28, 36, 45, 55,  2, 14,
+	  27, 41, 56,  8, 25, 43,
+	  62, 18, 39, 61, 20, 44};
+static const uint8_t pi[24] = \
+	{10,  7, 11, 17, 18, 3,
+	 5, 16,  8, 21, 24, 4,
+	 15, 23, 19, 13, 12, 2,
+	 20, 14, 22,  9, 6,  1};
+static const uint64_t RC[24] = \
+	{1ULL, 0x8082ULL, 0x800000000000808aULL, 0x8000000080008000ULL,
+	 0x808bULL, 0x80000001ULL, 0x8000000080008081ULL, 0x8000000000008009ULL,
+	 0x8aULL, 0x88ULL, 0x80008009ULL, 0x8000000aULL,
+	 0x8000808bULL, 0x800000000000008bULL, 0x8000000000008089ULL, 0x8000000000008003ULL,
+	 0x8000000000008002ULL, 0x8000000000000080ULL, 0x800aULL, 0x800000008000000aULL,
+	 0x8000000080008081ULL, 0x8000000000008080ULL, 0x80000001ULL, 0x8000000080008008ULL};
+
+/*** Helper macros to unroll the permutation. ***/
+#define rol(x, s) (((x) << s) | ((x) >> (64 - s)))
+#define REPEAT6(e) e e e e e e
+#define REPEAT24(e) REPEAT6(e e e e)
+#define REPEAT5(e) e e e e e
+#define FOR5(v, s, e)							\
+	v = 0;										\
+	REPEAT5(e; v += s;)
+
+/*** Keccak-f[1600] ***/
+static inline void keccakf(void* state) {
+	uint64_t* a = (uint64_t*)state;
+	uint64_t b[5] = {0};
+	uint64_t t = 0;
+	uint8_t x, y;
+
+	for (int i = 0; i < 24; i++) {
+		// Theta
+		FOR5(x, 1,
+				b[x] = 0;
+				FOR5(y, 5,
+						b[x] ^= a[x + y]; ))
+		FOR5(x, 1,
+				FOR5(y, 5,
+						a[y + x] ^= b[(x + 4) % 5] ^ rol(b[(x + 1) % 5], 1); ))
+		// Rho and pi
+		t = a[1];
+		x = 0;
+		REPEAT24(b[0] = a[pi[x]];
+				a[pi[x]] = rol(t, rho[x]);
+				t = b[0];
+				x++; )
+		// Chi
+		FOR5(y,
+				5,
+				FOR5(x, 1,
+						b[x] = a[y + x];)
+				FOR5(x, 1,
+				a[y + x] = b[x] ^ ((~b[(x + 1) % 5]) & b[(x + 2) % 5]); ))
+		// Iota
+		a[0] ^= RC[i];
+	}
+}
+
+/******** The FIPS202-defined functions. ********/
+
+/*** Some helper macros. ***/
+
+#define _(S) do { S } while (0)
+#define FOR(i, ST, L, S)							\
+	_(for (size_t i = 0; i < L; i += ST) { S; })
+#define mkapply_ds(NAME, S)						\
+	static inline void NAME(uint8_t* dst,			\
+		const uint8_t* src,						\
+		size_t len) {								\
+		FOR(i, 1, len, S);							\
+	}
+#define mkapply_sd(NAME, S)						\
+	static inline void NAME(const uint8_t* src,	\
+		uint8_t* dst,								\
+		size_t len) {								\
+		FOR(i, 1, len, S);							\
+	}
+
+mkapply_ds(xorin, dst[i] ^= src[i])  // xorin
+mkapply_sd(setout, dst[i] = src[i])  // setout
+
+#define P keccakf
+#define Plen 200
+
+// Fold P*F over the full blocks of an input.
+#define foldP(I, L, F)								\
+	while (L >= rate) {							\
+		F(a, I, rate);								\
+		P(a);										\
+		I += rate;									\
+		L -= rate;									\
+	}
+
+/** The sponge-based hash construction. **/
+static inline int hash(uint8_t* out, size_t outlen,
+		const uint8_t* in, size_t inlen,
+		size_t rate, uint8_t delim) {
+	if ((out == NULL) || ((in == NULL) && inlen != 0) || (rate >= Plen)) {
+		return -1;
+	}
+	uint8_t a[Plen] = {0};
+	// Absorb input.
+	foldP(in, inlen, xorin);
+	// Xor in the DS and pad frame.
+	a[inlen] ^= delim;
+	a[rate - 1] ^= 0x80;
+	// Xor in the last block.
+	xorin(a, in, inlen);
+	// Apply P
+	P(a);
+	// Squeeze output.
+	foldP(out, outlen, setout);
+	setout(a, out, outlen);
+	memset(a, 0, 200);
+	return 0;
+}
+
+#define defsha3(bits)													\
+	int sha3_##bits(uint8_t* out, size_t outlen,						\
+		const uint8_t* in, size_t inlen) {								\
+		if (outlen > (bits/8)) {										\
+			return -1;                                                  \
+		}																\
+		return hash(out, outlen, in, inlen, 200 - (bits / 4), 0x01);	\
+	}
+
+/*** FIPS202 SHA3 FOFs ***/
+defsha3(256)
+defsha3(512)
diff --git a/hevm-cli/hevm-cli.hs b/hevm-cli/hevm-cli.hs
new file mode 100644
--- /dev/null
+++ b/hevm-cli/hevm-cli.hs
@@ -0,0 +1,372 @@
+-- Main file of the hevm CLI program
+
+{-# Language BangPatterns #-}
+{-# Language CPP #-}
+{-# Language DeriveGeneric #-}
+{-# Language GeneralizedNewtypeDeriving #-}
+{-# Language LambdaCase #-}
+{-# Language NumDecimals #-}
+{-# Language OverloadedStrings #-}
+{-# Language TemplateHaskell #-}
+
+import EVM.Concrete (w256)
+
+import qualified EVM as EVM
+import qualified EVM.Concrete as EVM
+import qualified EVM.FeeSchedule as FeeSchedule
+import qualified EVM.Fetch
+import qualified EVM.Flatten
+import qualified EVM.Stepper
+import qualified EVM.TTY as EVM.TTY
+import qualified EVM.Emacs as EVM.Emacs
+
+#if MIN_VERSION_aeson(1, 0, 0)
+import qualified EVM.VMTest as VMTest
+#endif
+
+import EVM.Debug
+import EVM.Exec
+import EVM.Solidity
+import EVM.Types hiding (word)
+import EVM.UnitTest (UnitTestOptions, coverageReport, coverageForUnitTestContract)
+import EVM.UnitTest (runUnitTestContract)
+import EVM.UnitTest (getParametersFromEnvironmentVariables, testNumber)
+import EVM.Dapp (findUnitTests, dappInfo)
+
+import qualified EVM.UnitTest as EVM.UnitTest
+
+import qualified Paths_hevm as Paths
+
+import Control.Concurrent.Async   (async, waitCatch)
+import Control.Exception          (evaluate)
+import Control.Lens
+import Control.Monad              (void, when, forM_)
+import Control.Monad.State.Strict (execState)
+import Data.ByteString            (ByteString)
+import Data.List                  (intercalate, isSuffixOf)
+import Data.Text                  (Text, unpack, pack)
+import Data.Maybe                 (fromMaybe)
+import System.Directory           (withCurrentDirectory, listDirectory)
+import System.Exit                (die, exitFailure)
+import System.IO                  (hFlush, stdout)
+import System.Process             (callProcess)
+import System.Timeout             (timeout)
+
+import qualified Data.ByteString        as ByteString
+import qualified Data.ByteString.Base16 as BS16
+import qualified Data.ByteString.Char8  as Char8
+import qualified Data.ByteString.Lazy   as LazyByteString
+import qualified Data.Map               as Map
+import qualified Options.Generic        as Options
+
+import qualified EVM.Facts     as Facts
+import qualified EVM.Facts.Git as Git
+
+import qualified Text.Regex.TDFA as Regex
+import qualified Data.Sequence as Seq
+
+-- This record defines the program's command-line options
+-- automatically via the `optparse-generic` package.
+data Command
+  = Exec
+      { code       :: ByteString
+      , calldata   :: Maybe ByteString
+      , address    :: Maybe Addr
+      , caller     :: Maybe Addr
+      , origin     :: Maybe Addr
+      , coinbase   :: Maybe Addr
+      , value      :: Maybe W256
+      , gas        :: Maybe W256
+      , number     :: Maybe W256
+      , timestamp  :: Maybe W256
+      , gaslimit   :: Maybe W256
+      , gasprice   :: Maybe W256
+      , difficulty :: Maybe W256
+      , debug      :: Bool
+      , state      :: Maybe String
+      }
+  | DappTest
+      { jsonFile           :: Maybe String
+      , dappRoot           :: Maybe String
+      , debug              :: Bool
+      , rpc                :: Maybe URL
+      , verbose            :: Bool
+      , coverage           :: Bool
+      , state              :: Maybe String
+      , match              :: Maybe String
+      }
+  | Interactive
+      { jsonFile           :: Maybe String
+      , dappRoot           :: Maybe String
+      , rpc                :: Maybe URL
+      , state              :: Maybe String
+      }
+  | VmTest
+      { file  :: String
+      , test  :: [String]
+      , debug :: Bool
+      }
+  | VmTestReport
+      { tests :: String
+      }
+  | Flatten
+    { sourceFile :: String
+    , jsonFile   :: Maybe String
+    , dappRoot   :: Maybe String
+    }
+  | Emacs
+  deriving (Show, Options.Generic, Eq)
+
+type URL = Text
+
+instance Options.ParseRecord Command where
+  parseRecord =
+    Options.parseRecordWithModifiers Options.lispCaseModifiers
+
+optsMode :: Command -> Mode
+optsMode x = if debug x then Debug else Run
+
+unitTestOptions :: Command -> IO UnitTestOptions
+unitTestOptions cmd = do
+  vmModifier <-
+    case state cmd of
+      Nothing ->
+        pure id
+      Just repoPath -> do
+        facts <- Git.loadFacts (Git.RepoAt repoPath)
+        pure (flip Facts.apply facts)
+
+  params <- getParametersFromEnvironmentVariables
+
+  pure EVM.UnitTest.UnitTestOptions
+    { EVM.UnitTest.oracle =
+        case rpc cmd of
+         Just url -> EVM.Fetch.http (EVM.Fetch.BlockNumber (testNumber params)) url
+         Nothing  -> EVM.Fetch.zero
+    , EVM.UnitTest.verbose = verbose cmd
+    , EVM.UnitTest.match   = pack $ fromMaybe "^test" (match cmd)
+    , EVM.UnitTest.vmModifier = vmModifier
+    , EVM.UnitTest.testParams = params
+    }
+
+main :: IO ()
+main = do
+  cmd <- Options.getRecord "hevm -- Ethereum evaluator"
+  let
+    root = fromMaybe "." (dappRoot cmd)
+  case cmd of
+    Exec {} ->
+      launchExec cmd
+    VmTest {} ->
+      launchVMTest cmd
+    DappTest {} ->
+      withCurrentDirectory root $ do
+        testFile <- findJsonFile (jsonFile cmd)
+        testOpts <- unitTestOptions cmd
+        case coverage cmd of
+          False ->
+            dappTest testOpts (optsMode cmd) testFile
+          True ->
+            dappCoverage testOpts (optsMode cmd) testFile
+    Interactive {} ->
+      withCurrentDirectory root $ do
+        testFile <- findJsonFile (jsonFile cmd)
+        testOpts <- unitTestOptions cmd
+        EVM.TTY.main testOpts root testFile
+    VmTestReport {} ->
+      withCurrentDirectory (tests cmd) $ do
+        dataDir <- Paths.getDataDir
+        callProcess "bash" [dataDir ++ "/run-consensus-tests", "."]
+    Flatten {} ->
+      withCurrentDirectory root $ do
+        theJson <- findJsonFile (jsonFile cmd)
+        readSolc theJson >>=
+          \case
+            Just (contractMap, cache) -> do
+              let dapp = dappInfo "." contractMap cache
+              EVM.Flatten.flatten dapp (pack (sourceFile cmd))
+            Nothing ->
+              error ("Failed to read Solidity JSON for `" ++ theJson ++ "'")
+    Emacs ->
+      EVM.Emacs.main
+
+findJsonFile :: Maybe String -> IO String
+findJsonFile (Just s) = pure s
+findJsonFile Nothing = do
+  outFiles <- listDirectory "out"
+  case filter (isSuffixOf ".sol.json") outFiles of
+    [x] -> pure ("out/" ++ x)
+    [] ->
+      error $ concat
+        [ "No `*.sol.json' file found in `./out'.\n"
+        , "Maybe you need to run `dapp build'.\n"
+        , "You can specify a file with `--json-file'."
+        ]
+    xs ->
+      error $ concat
+        [ "Multiple `*.sol.json' files found in `./out'.\n"
+        , "Specify one using `--json-file'.\n"
+        , "Files found: "
+        , intercalate ", " xs
+        ]
+
+dappTest :: UnitTestOptions -> Mode -> String -> IO ()
+dappTest opts _ solcFile = do
+  readSolc solcFile >>=
+    \case
+      Just (contractMap, cache) -> do
+        let matcher = regexMatches (EVM.UnitTest.match opts)
+        let unitTests = (findUnitTests matcher) (Map.elems contractMap)
+        results <- mapM (runUnitTestContract opts contractMap cache) unitTests
+        when (any (== False) results) exitFailure
+      Nothing ->
+        error ("Failed to read Solidity JSON for `" ++ solcFile ++ "'")
+
+regexMatches :: Text -> Text -> Bool
+regexMatches regexSource =
+  let
+    compOpts =
+      Regex.defaultCompOpt { Regex.lastStarGreedy = True }
+    execOpts =
+      Regex.defaultExecOpt { Regex.captureGroups = False }
+    regex = Regex.makeRegexOpts compOpts execOpts (unpack regexSource)
+  in
+    Regex.matchTest regex . Seq.fromList . unpack
+
+dappCoverage :: UnitTestOptions -> Mode -> String -> IO ()
+dappCoverage opts _ solcFile = do
+  readSolc solcFile >>=
+    \case
+      Just (contractMap, cache) -> do
+        let matcher = regexMatches (EVM.UnitTest.match opts)
+        let unitTests = (findUnitTests matcher) (Map.elems contractMap)
+        covs <- mconcat <$> mapM (coverageForUnitTestContract opts contractMap cache) unitTests
+
+        let
+          dapp = dappInfo "." contractMap cache
+          f (k, vs) = do
+            putStr "***** hevm coverage for "
+            putStrLn (unpack k)
+            putStrLn ""
+            forM_ vs $ \(n, bs) -> do
+              case ByteString.find (\x -> x /= 0x9 && x /= 0x20 && x /= 0x7d) bs of
+                Nothing -> putStr "..... "
+                Just _ ->
+                  case n of
+                    -1 -> putStr ";;;;; "
+                    0  -> putStr "##### "
+                    _  -> putStr "      "
+              Char8.putStrLn bs
+            putStrLn ""
+
+        mapM_ f (Map.toList (coverageReport dapp covs))
+      Nothing ->
+        error ("Failed to read Solidity JSON for `" ++ solcFile ++ "'")
+
+launchExec :: Command -> IO ()
+launchExec cmd = do
+  let vm = vmFromCommand cmd
+  vm1 <- case state cmd of
+    Nothing -> pure vm
+    Just path ->
+      -- Note: this will load the code, so if you've specified a state
+      -- repository, then you effectively can't change `--code' after
+      -- the first run.
+      Facts.apply vm <$> Git.loadFacts (Git.RepoAt path)
+
+  case optsMode cmd of
+    Run ->
+      let vm' = execState exec vm1
+      in case view EVM.result vm' of
+        Nothing ->
+          error "internal error; no EVM result"
+        Just (EVM.VMFailure e) -> do
+          die (show e)
+        Just (EVM.VMSuccess (EVM.B x)) -> do
+          let hex = BS16.encode x
+          if ByteString.null hex then pure ()
+            else do
+              ByteString.putStr hex
+              putStrLn ""
+          case state cmd of
+            Nothing -> pure ()
+            Just path ->
+              Git.saveFacts (Git.RepoAt path) (Facts.vmFacts vm')
+    Debug ->
+      void (EVM.TTY.runFromVM vm1)
+
+vmFromCommand :: Command -> EVM.VM
+vmFromCommand cmd =
+  vm1 & EVM.env . EVM.contracts . ix address' . EVM.balance +~ (w256 value')
+  where
+    value'   = word value 0
+    address' = addr address 1
+    vm1 = EVM.makeVm $ EVM.VMOpts
+      { EVM.vmoptCode       = hexByteString "--code" (code cmd)
+      , EVM.vmoptCalldata   = maybe "" (hexByteString "--calldata")
+                                (calldata cmd)
+      , EVM.vmoptValue      = value'
+      , EVM.vmoptAddress    = address'
+      , EVM.vmoptCaller     = addr caller 2
+      , EVM.vmoptOrigin     = addr origin 3
+      , EVM.vmoptGas        = word gas 0
+      , EVM.vmoptCoinbase   = addr coinbase 0
+      , EVM.vmoptNumber     = word number 0
+      , EVM.vmoptTimestamp  = word timestamp 0
+      , EVM.vmoptGaslimit   = word gaslimit 0
+      , EVM.vmoptGasprice   = word gasprice 0
+      , EVM.vmoptDifficulty = word difficulty 0
+      , EVM.vmoptSchedule   = FeeSchedule.metropolis
+      }
+    word f def = maybe def id (f cmd)
+    addr f def = maybe def id (f cmd)
+
+launchVMTest :: Command -> IO ()
+launchVMTest cmd =
+#if MIN_VERSION_aeson(1, 0, 0)
+  VMTest.parseSuite <$> LazyByteString.readFile (file cmd) >>=
+   \case
+     Left err -> print err
+     Right allTests ->
+       let testFilter =
+             if null (test cmd)
+             then id
+             else filter (\(x, _) -> elem x (test cmd))
+       in
+         mapM_ (runVMTest (optsMode cmd)) $
+           testFilter (Map.toList allTests)
+#else
+  putStrLn "Not supported"
+#endif
+
+#if MIN_VERSION_aeson(1, 0, 0)
+runVMTest :: Mode -> (String, VMTest.Case) -> IO Bool
+runVMTest mode (name, x) = do
+  let
+    vm0 = VMTest.vmForCase x
+    m = void EVM.Stepper.execFully >> EVM.Stepper.evm EVM.finalize
+
+  putStr (name ++ " ")
+  hFlush stdout
+  result <- do
+    action <- async $
+      case mode of
+        Run ->
+          timeout (1e6) . evaluate $ do
+            execState (VMTest.interpret m) vm0
+        Debug ->
+          Just <$> EVM.TTY.runFromVM vm0
+    waitCatch action
+  case result of
+    Right (Just vm1) -> do
+      ok <- VMTest.checkExpectation x vm1
+      putStrLn (if ok then "ok" else "")
+      return ok
+    Right Nothing -> do
+      putStrLn "timeout"
+      return False
+    Left _ -> do
+      putStrLn "error"
+      return False
+
+#endif
diff --git a/hevm.cabal b/hevm.cabal
new file mode 100644
--- /dev/null
+++ b/hevm.cabal
@@ -0,0 +1,204 @@
+name:
+  hevm
+version:
+  0.16
+synopsis:
+  Ethereum virtual machine evaluator
+description:
+  Hevm implements the Ethereum virtual machine semantics.
+  .
+  It can be used as a library, and it also comes with an executable
+  that can run unit test suites, optionally with a visual TTY debugger.
+homepage:
+  https://github.com/dapphub/dapptools
+license:
+  AGPL-3
+license-file:
+  COPYING
+author:
+  Mikael Brockman
+maintainer:
+  mikael@brockman.se
+category:
+  Ethereum
+build-type:
+  Simple
+cabal-version:
+  >=1.10
+data-files:
+  run-consensus-tests
+extra-source-files:
+  CHANGELOG.md
+
+library
+  exposed-modules:
+    EVM,
+    EVM.ABI,
+    EVM.Concrete,
+    EVM.Dapp,
+    EVM.Dev,
+    EVM.Debug,
+    EVM.Emacs,
+    EVM.Exec,
+    EVM.Facts,
+    EVM.Facts.Git,
+    EVM.Flatten,
+    EVM.Format,
+    EVM.Fetch,
+    EVM.FeeSchedule,
+    EVM.Op,
+    EVM.Precompiled,
+    EVM.Keccak,
+    EVM.Solidity,
+    EVM.Stepper,
+    EVM.StorageLayout,
+    EVM.TTY,
+    EVM.TTYCenteredList,
+    EVM.Types,
+    EVM.UnitTest,
+    EVM.VMTest,
+    Paths_hevm
+  ghc-options:
+    -Wall -Wno-deprecations
+  extra-libraries:
+    secp256k1
+  c-sources:
+    ethjet/ethjet.c, ethjet/tinykeccak.c
+  build-depends:
+    QuickCheck                        >= 2.9,
+    abstract-par                      >= 0.3,
+    aeson                             >= 1.0,
+    ansi-wl-pprint                    >= 0.6,
+    base                              >= 4.9 && < 5,
+    base16-bytestring                 >= 0.1,
+    base64-bytestring                 >= 1.0,
+    binary                            >= 0.8,
+    brick                             >= 0.18,
+    bytestring                        >= 0.10,
+    cereal                            >= 0.5,
+    containers                        >= 0.5,
+    cryptonite                        >= 0.21,
+    data-dword                        >= 0.3,
+    deepseq                           >= 1.4,
+    directory                         >= 1.3,
+    filepath                          >= 1.4,
+    fgl                               >= 5.0,
+    ghci-pretty                       >= 0.0,
+    haskeline                         >= 0.7,
+    time                              >= 1.8,
+    transformers                      >= 0.5,
+    lens                              >= 4.15,
+    lens-aeson                        >= 1.0,
+    megaparsec                        >= 6.0,
+    memory                            >= 0.14,
+    monad-par                         >= 0.3,
+    mtl                               >= 2.2,
+    multiset                          >= 0.3,
+    operational                       >= 0.2,
+    optparse-generic                  >= 1.1,
+    process                           >= 1.4,
+    quickcheck-text                   >= 0.1,
+    readline                          >= 1.0,
+    restless-git                      >= 0.6,
+    rosezipper                        >= 0.2,
+    scientific                        >= 0.3,
+    s-cargot                          >= 0.1,
+    temporary                         >= 1.2,
+    text                              >= 1.2,
+    text-format                       >= 0.3,
+    tree-view                         == 0.5,
+    unordered-containers              >= 0.2,
+    vector                            >= 0.11,
+    vty                               >= 5.15,
+    wreq                              >= 0.5
+  hs-source-dirs:
+    src
+  default-language:
+    Haskell2010
+  default-extensions:
+    BangPatterns,
+    DeriveDataTypeable,
+    DeriveGeneric,
+    FlexibleContexts,
+    GeneralizedNewtypeDeriving,
+    LambdaCase,
+    OverloadedStrings,
+    Rank2Types,
+    RecordWildCards,
+    TypeFamilies,
+    ViewPatterns
+
+executable hevm
+  default-language:
+    Haskell2010
+  hs-source-dirs:
+    hevm-cli
+  main-is:
+    hevm-cli.hs
+  ghc-options:
+    -Wall -threaded -with-rtsopts=-N
+  build-depends:
+    QuickCheck                        >= 2.9,
+    aeson                             >= 1.0,
+    ansi-wl-pprint                    >= 0.6,
+    async                             == 2.*,
+    base                              >= 4.9 && < 5,
+    base16-bytestring                 >= 0.1,
+    base64-bytestring                 >= 1.0,
+    binary                            >= 0.8,
+    brick                             >= 0.18,
+    bytestring                        >= 0.10,
+    containers                        >= 0.5,
+    cryptonite                        >= 0.21,
+    data-dword                        >= 0.3,
+    deepseq                           >= 1.4,
+    directory                         >= 1.3,
+    filepath                          >= 1.4,
+    ghci-pretty                       >= 0.0,
+    hevm,
+    lens                              >= 4.15,
+    lens-aeson                        >= 1.0,
+    memory                            >= 0.14,
+    mtl                               >= 2.2,
+    optparse-generic                  >= 1.1,
+    process                           >= 1.4,
+    quickcheck-text                   >= 0.1,
+    readline                          >= 1.0,
+    regex-tdfa                        >= 1.2,
+    temporary                         >= 1.2,
+    text                              >= 1.2,
+    text-format                       >= 0.3,
+    unordered-containers              >= 0.2,
+    vector                            >= 0.11,
+    vty                               >= 5.15
+
+test-suite test
+  default-language:
+    Haskell2010
+  ghc-options:
+    -Wall
+  type:
+    exitcode-stdio-1.0
+  hs-source-dirs:
+    test
+  main-is:
+    test.hs
+  extra-libraries:
+    secp256k1
+  build-depends:
+    HUnit >= 1.6,
+    QuickCheck >= 2.9,
+    base >= 4.9 && < 5,
+    base16-bytestring >= 0.1,
+    ghci-pretty >= 0.0.2,
+    hevm,
+    tasty >= 1.0,
+    tasty-hunit >= 0.10,
+    tasty-quickcheck >= 0.9,
+    mtl >= 2.2,
+    lens >= 4.16,
+    text >= 1.2,
+    here >= 1.2,
+    bytestring >= 0.10,
+    vector >= 0.12,
+    binary >= 0.8
diff --git a/run-consensus-tests b/run-consensus-tests
new file mode 100644
--- /dev/null
+++ b/run-consensus-tests
@@ -0,0 +1,82 @@
+#!/usr/bin/env bash
+set -e
+
+if [[ $# != 1 ]]; then
+  echo >&2 "usage: $(basename "$0") <tests-dir>"
+  exit 1
+fi
+
+{
+  cd "$1"
+  for x in VMTests/*/*; do
+    echo >&2 "$x"
+    echo -n "$x " ; hevm vm-test --file $x
+  done
+} | {
+  while read path test outcome; do
+    category=$(dirname "$path")
+    testcase=$(basename "${path%.json}")
+    row="<tr><td class=testcase>$testcase<td>$outcome<td class=category>$category"
+    row+=$'\n'
+    case $outcome in
+      ok) passed+=$row ;;
+      *)  failed+=$row ;;
+    esac
+  done
+  
+  cat <<.
+<!doctype html>
+<title>hevm test results</title>
+<style>
+* {
+  font-family:
+    "latin modern mono", "fantasque sans mono",
+    inconsolata, menlo, monospace;
+  font-size: 22px;
+  line-height: 26px;
+}
+
+body { margin: 2rem; }
+header { text-align: center; margin: 4rem 0; }
+table { border-collapse: collapse; width: 100%; }
+tr:nth-child(even) { background: rgba(0, 0, 0, 0.05); }
+td:not(:first-child):not(:last-child) { padding: 0 1rem; }
+.category { opacity: 0.6; text-align: right }
+a { color: darkblue; text-decoration: none; }
+h1, h2 { text-align: center; margin-top: 2rem  }
+.testcase { font-weight: bold }
+#failed .testcase { color: rgb(200, 0, 0) }
+#passed .testcase { color: rgb(0, 150, 0) }
+</style>
+<header>
+<h1>hevm consensus test report</h1>
+<p>
+$(date +%Y-%m-%d)
+<p>
+.
+
+  wc -l <<<"$passed"
+  echo "passed, "
+  wc -l <<<"$failed"
+  echo "failed"
+  
+  cat <<.
+<p>
+(Test suite: <span class=VMTests</span>VMTests</span> for Homestead)
+</header>
+<h2>Failed tests</h2>
+<table id=failed>
+<tbody>
+.
+  echo "$failed"
+  cat <<.
+</table>
+<h2>Passed tests</h2>
+<table id=passed>
+<tbody>
+.
+  echo "$passed"
+  cat <<.
+</table>
+.
+}
diff --git a/src/EVM.hs b/src/EVM.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM.hs
@@ -0,0 +1,1679 @@
+{-# Language ImplicitParams #-}
+{-# Language ConstraintKinds #-}
+{-# Language FlexibleInstances #-}
+{-# Language GADTs #-}
+{-# Language RecordWildCards #-}
+{-# Language ScopedTypeVariables #-}
+{-# Language StandaloneDeriving #-}
+{-# Language StrictData #-}
+{-# Language TemplateHaskell #-}
+{-# Language TypeOperators #-}
+{-# Language ViewPatterns #-}
+
+module EVM where
+
+import Prelude hiding ((^), log, Word, exponent)
+
+import EVM.ABI
+import EVM.Types
+import EVM.Solidity
+import EVM.Keccak
+import EVM.Concrete
+import EVM.Op
+import EVM.FeeSchedule (FeeSchedule (..))
+
+import qualified EVM.Precompiled
+
+import Data.Binary.Get (runGetOrFail)
+import Data.Bits (bit, testBit, complement)
+import Data.Bits (xor, shiftR, (.&.), (.|.), FiniteBits (..))
+import Data.Text (Text)
+import Data.Word (Word8, Word32)
+
+import Control.Lens hiding (op, (:<), (|>))
+import Control.Monad.State.Strict hiding (state)
+
+import Data.ByteString              (ByteString)
+import Data.ByteString.Lazy         (fromStrict)
+import Data.Map.Strict              (Map)
+import Data.Maybe                   (fromMaybe, isNothing)
+import Data.Sequence                (Seq)
+import Data.Vector.Storable         (Vector)
+import Data.Foldable                (toList)
+
+import Data.Tree
+
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.Map.Strict      as Map
+import qualified Data.Sequence        as Seq
+import qualified Data.Tree.Zipper     as Zipper
+import qualified Data.Vector.Storable as Vector
+import qualified Data.Vector.Storable.Mutable as Vector
+
+import qualified Data.Vector as RegularVector
+
+-- * Data types
+
+data Error
+  = BalanceTooLow Word Word
+  | UnrecognizedOpcode Word8
+  | SelfDestruction
+  | StackUnderrun
+  | BadJumpDestination
+  | Revert
+  | NoSuchContract Addr
+  | OutOfGas Word Word
+  | BadCheatCode Word32
+  | StackLimitExceeded
+  | IllegalOverflow
+  | Query Query
+  | PrecompiledContractError Int
+  | StateChangeWhileStatic
+
+deriving instance Show Error
+
+-- | The possible result states of a VM
+data VMResult
+  = VMFailure Error  -- ^ An operation failed
+  | VMSuccess Blob   -- ^ Reached STOP, RETURN, or end-of-code
+
+deriving instance Show VMResult
+
+-- | The state of a stepwise EVM execution
+data VM = VM
+  { _result        :: Maybe VMResult
+  , _state         :: FrameState
+  , _frames        :: [Frame]
+  , _env           :: Env
+  , _block         :: Block
+  , _tx            :: TxState
+  , _logs          :: Seq Log
+  , _traces        :: Zipper.TreePos Zipper.Empty Trace
+  , _cache         :: Cache
+  , _execMode      :: ExecMode
+  , _burned        :: Word
+  }
+
+data Trace = Trace
+  { _traceCodehash :: W256
+  , _traceOpIx     :: Int
+  , _traceData     :: TraceData
+  }
+
+data TraceData
+  = EventTrace Log
+  | FrameTrace FrameContext
+  | QueryTrace Query
+  | ErrorTrace Error
+  | EntryTrace Text
+  | ReturnTrace Blob FrameContext
+
+data ExecMode = ExecuteNormally | ExecuteAsVMTest
+
+data Query where
+  PleaseFetchContract :: Addr         -> (Contract -> EVM ()) -> Query
+  PleaseFetchSlot     :: Addr -> Word -> (Word     -> EVM ()) -> Query
+
+instance Show Query where
+  showsPrec _ = \case
+    PleaseFetchContract addr _ ->
+      (("<EVM.Query: fetch contract " ++ show addr ++ ">") ++)
+    PleaseFetchSlot addr slot _ ->
+      (("<EVM.Query: fetch slot "
+        ++ show slot ++ " for "
+        ++ show addr ++ ">") ++)
+
+-- | Alias for the type of e.g. @exec1@.
+type EVM a = State VM a
+
+-- | The cache is data that can be persisted for efficiency:
+-- any expensive query that is constant at least within a block.
+data Cache = Cache
+  { _fetched :: Map Addr Contract
+  }
+
+-- | A way to specify an initial VM state
+data VMOpts = VMOpts
+  { vmoptCode :: ByteString
+  , vmoptCalldata :: ByteString
+  , vmoptValue :: W256
+  , vmoptAddress :: Addr
+  , vmoptCaller :: Addr
+  , vmoptOrigin :: Addr
+  , vmoptGas :: W256
+  , vmoptNumber :: W256
+  , vmoptTimestamp :: W256
+  , vmoptCoinbase :: Addr
+  , vmoptDifficulty :: W256
+  , vmoptGaslimit :: W256
+  , vmoptGasprice :: W256
+  , vmoptSchedule :: FeeSchedule Word
+  } deriving Show
+
+-- | A log entry
+data Log = Log Addr Blob [Word]
+
+-- | An entry in the VM's "call/create stack"
+data Frame = Frame
+  { _frameContext   :: FrameContext
+  , _frameState     :: FrameState
+  }
+
+-- | Call/create info
+data FrameContext
+  = CreationContext
+    { creationContextCodehash :: W256 }
+  | CallContext
+    { callContextOffset   :: Word
+    , callContextSize     :: Word
+    , callContextCodehash :: W256
+    , callContextAbi      :: Maybe Word
+    , callContextData     :: Blob
+    , callContextReversion :: Map Addr Contract
+    }
+
+-- | The "registers" of the VM along with memory and data stack
+data FrameState = FrameState
+  { _contract     :: Addr
+  , _codeContract :: Addr
+  , _code         :: ByteString
+  , _pc           :: Int
+  , _stack        :: [Word]
+  , _memory       :: Memory
+  , _memorySize   :: Int
+  , _calldata     :: Blob
+  , _callvalue    :: Word
+  , _caller       :: Addr
+  , _gas          :: Word
+  , _returndata   :: Blob
+  , _static       :: Bool
+  }
+
+-- | The state that spans a whole transaction
+data TxState = TxState
+  { _selfdestructs :: [Addr]
+  , _refunds       :: [(Addr, Word)]
+  }
+
+-- | The state of a contract
+data Contract = Contract
+  { _bytecode :: ByteString
+  , _storage  :: Map Word Word
+  , _balance  :: Word
+  , _nonce    :: Word
+  , _codehash :: W256
+  , _codesize :: Int -- (redundant?)
+  , _opIxMap  :: Vector Int
+  , _codeOps  :: RegularVector.Vector (Int, Op)
+  , _external :: Bool
+  }
+
+deriving instance Show Contract
+deriving instance Eq Contract
+
+-- | Various environmental data
+data Env = Env
+  { _contracts :: Map Addr Contract
+  , _sha3Crack :: Map Word Blob
+  , _origin    :: Addr
+  }
+
+
+-- | Data about the block
+data Block = Block
+  { _coinbase   :: Addr
+  , _timestamp  :: Word
+  , _number     :: Word
+  , _difficulty :: Word
+  , _gaslimit   :: Word
+  , _gasprice   :: Word
+  , _schedule   :: FeeSchedule Word
+  }
+
+blankState :: FrameState
+blankState = FrameState
+  { _contract     = 0
+  , _codeContract = 0
+  , _code         = mempty
+  , _pc           = 0
+  , _stack        = mempty
+  , _memory       = mempty
+  , _memorySize   = 0
+  , _calldata     = mempty
+  , _callvalue    = 0
+  , _caller       = 0
+  , _gas          = 0
+  , _returndata   = mempty
+  , _static       = False
+  }
+
+makeLenses ''FrameState
+makeLenses ''Frame
+makeLenses ''Block
+makeLenses ''TxState
+makeLenses ''Contract
+makeLenses ''Env
+makeLenses ''Cache
+makeLenses ''Trace
+makeLenses ''VM
+
+instance Monoid Cache where
+  mempty = Cache { _fetched = mempty }
+  mappend a b = Cache
+    { _fetched = mappend (view fetched a) (view fetched b)
+    }
+
+-- * Data accessors
+
+currentContract :: VM -> Maybe Contract
+currentContract vm =
+  view (env . contracts . at (view (state . codeContract) vm)) vm
+
+-- * Data constructors
+
+makeVm :: VMOpts -> VM
+makeVm o = VM
+  { _result = Nothing
+  , _frames = mempty
+  , _tx = TxState
+    { _selfdestructs = mempty
+    , _refunds = mempty
+    }
+  , _logs = mempty
+  , _traces = Zipper.fromForest []
+  , _block = Block
+    { _coinbase = vmoptCoinbase o
+    , _timestamp = w256 $ vmoptTimestamp o
+    , _number = w256 $ vmoptNumber o
+    , _difficulty = w256 $ vmoptDifficulty o
+    , _gaslimit = w256 $ vmoptGaslimit o
+    , _gasprice = w256 $ vmoptGasprice o
+    , _schedule = vmoptSchedule o
+    }
+  , _state = FrameState
+    { _pc = 0
+    , _stack = mempty
+    , _memory = mempty
+    , _memorySize = 0
+    , _code = vmoptCode o
+    , _contract = vmoptAddress o
+    , _codeContract = vmoptAddress o
+    , _calldata = B $ vmoptCalldata o
+    , _callvalue = w256 $ vmoptValue o
+    , _caller = vmoptCaller o
+    , _gas = w256 $ vmoptGas o
+    , _returndata = mempty
+    , _static = False
+    }
+  , _env = Env
+    { _sha3Crack = mempty
+    , _origin = vmoptOrigin o
+    , _contracts = Map.fromList
+      [(vmoptAddress o, initialContract (vmoptCode o))]
+    }
+  , _cache = mempty
+  , _execMode = ExecuteNormally
+  , _burned = 0
+  }
+
+initialContract :: ByteString -> Contract
+initialContract theCode = Contract
+  { _bytecode = theCode
+  , _codesize = BS.length theCode
+  , _codehash =
+    if BS.null theCode then 0 else
+      keccak (stripBytecodeMetadata theCode)
+  , _storage  = mempty
+  , _balance  = 0
+  , _nonce    = 0
+  , _opIxMap  = mkOpIxMap theCode
+  , _codeOps  = mkCodeOps theCode
+  , _external = False
+  }
+
+-- * Opcode dispatch (exec1)
+
+next :: (?op :: Word8) => EVM ()
+next = modifying (state . pc) (+ (opSize ?op))
+
+exec1 :: EVM ()
+exec1 = do
+  vm <- get
+
+  let
+    -- Convenience function to access parts of the current VM state.
+    -- Arcane type signature needed to avoid monomorphism restriction.
+    the :: (b -> VM -> Const a VM) -> ((a -> Const a a) -> b) -> a
+    the f g = view (f . g) vm
+
+    -- Convenient aliases
+    mem  = the state memory
+    stk  = the state stack
+    self = the state contract
+    this = fromMaybe (error "internal error: state contract") (preview (ix (the state contract)) (the env contracts))
+
+    fees@(FeeSchedule {..}) = the block schedule
+
+    doStop =
+      case vm ^. frames of
+        [] ->
+          assign result (Just (VMSuccess ""))
+        (nextFrame : remainingFrames) -> do
+          popTrace
+          assign frames remainingFrames
+          assign state (view frameState nextFrame)
+          case view frameContext nextFrame of
+            CreationContext _ -> do
+              -- Move back the gas to the parent context
+              assign (state . gas) (the state gas)
+
+            CallContext _ _ _ _ _ _ -> do
+              -- Take back the remaining gas allowance
+              modifying (state . gas) (+ the state gas)
+              modifying burned (subtract (the state gas))
+          push 1
+
+  if the state pc >= num (BS.length (the state code))
+    then
+      case view frames vm of
+        (nextFrame : remainingFrames) -> do
+          assign frames remainingFrames
+          assign state (view frameState nextFrame)
+          push 1
+        [] ->
+          assign result (Just (VMSuccess (blob "")))
+
+    else do
+      let ?op = BS.index (the state code) (the state pc)
+
+      case ?op of
+
+        -- op: PUSH
+        x | x >= 0x60 && x <= 0x7f -> do
+          let !n = num x - 0x60 + 1
+              !xs = BS.take n (BS.drop (1 + the state pc)
+                                       (the state code))
+          limitStack 1 $
+            burn g_verylow $ do
+              next
+              push (w256 (word xs))
+
+        -- op: DUP
+        x | x >= 0x80 && x <= 0x8f -> do
+          let !i = x - 0x80 + 1
+          case preview (ix (num i - 1)) stk of
+            Nothing -> underrun
+            Just y -> do
+              limitStack 1 $
+                burn g_verylow $ do
+                  next
+                  push y
+
+        -- op: SWAP
+        x | x >= 0x90 && x <= 0x9f -> do
+          let i = num (x - 0x90 + 1)
+          if length stk < i + 1
+            then underrun
+            else
+              burn g_verylow $ do
+                next
+                zoom (state . stack) $ do
+                  assign (ix 0) (stk ^?! ix i)
+                  assign (ix i) (stk ^?! ix 0)
+
+        -- op: LOG
+        x | x >= 0xa0 && x <= 0xa4 ->
+          notStatic $
+          let n = (num x - 0xa0) in
+          case stk of
+            (xOffset:xSize:xs) ->
+              if length xs < n
+              then underrun
+              else do
+                let (topics, xs') = splitAt n xs
+                    bytes         = readMemory (num xOffset) (num xSize) vm
+                    log           = Log self bytes topics
+
+                burn (g_log + g_logdata * xSize + num n * g_logtopic) $ do
+                  accessMemoryRange fees xOffset xSize $ do
+                    traceLog log
+                    next
+                    assign (state . stack) xs'
+                    pushToSequence logs log
+            _ ->
+              underrun
+
+        -- op: STOP
+        0x00 -> doStop
+
+        -- op: ADD
+        0x01 -> stackOp2 (const g_verylow) (uncurry (+))
+        -- op: MUL
+        0x02 -> stackOp2 (const g_low) (uncurry (*))
+        -- op: SUB
+        0x03 -> stackOp2 (const g_verylow) (uncurry (-))
+
+        -- op: DIV
+        0x04 -> stackOp2 (const g_low) $
+          \case (_, 0) -> 0
+                (x, y) -> div x y
+
+        -- op: SDIV
+        0x05 ->
+          stackOp2 (const g_low) (uncurry (sdiv))
+
+        -- op: MOD
+        0x06 -> stackOp2 (const g_low) $ \case
+          (_, 0) -> 0
+          (x, y) -> mod x y
+
+        -- op: SMOD
+        0x07 -> stackOp2 (const g_low) $ uncurry smod
+        -- op: ADDMOD
+        0x08 -> stackOp3 (const g_mid) $ (\(x, y, z) -> addmod x y z)
+        -- op: MULMOD
+        0x09 -> stackOp3 (const g_mid) $ (\(x, y, z) -> mulmod x y z)
+
+        -- op: LT
+        0x10 -> stackOp2 (const g_verylow) $ \(x, y) -> if x < y then 1 else 0
+        -- op: GT
+        0x11 -> stackOp2 (const g_verylow) $ \(x, y) -> if x > y then 1 else 0
+        -- op: SLT
+        0x12 -> stackOp2 (const g_verylow) $ uncurry slt
+        -- op: SGT
+        0x13 -> stackOp2 (const g_verylow) $ uncurry sgt
+
+        -- op: EQ
+        0x14 -> stackOp2 (const g_verylow) $ \(x, y) -> if x == y then 1 else 0
+        -- op: ISZERO
+        0x15 -> stackOp1 (const g_verylow) $ \case 0 -> 1; _ -> 0
+
+        -- op: AND
+        0x16 -> stackOp2 (const g_verylow) $ uncurry (.&.)
+        -- op: OR
+        0x17 -> stackOp2 (const g_verylow) $ uncurry (.|.)
+        -- op: XOR
+        0x18 -> stackOp2 (const g_verylow) $ uncurry xor
+        -- op: NOT
+        0x19 -> stackOp1 (const g_verylow) complement
+
+        -- op: BYTE
+        0x1a -> stackOp2 (const g_verylow) $ \case
+          (n, _) | n >= 32 ->
+            0
+          (n, x) ->
+            0xff .&. shiftR x (8 * (31 - num n))
+
+        -- op: SHA3
+        0x20 ->
+          case stk of
+            ((num -> xOffset) : (num -> xSize) : xs) -> do
+              let bytes = readMemory xOffset xSize vm
+                  hash  = keccakBlob bytes
+              burn (g_sha3 + g_sha3word * ceilDiv (num xSize) 32) $
+                accessMemoryRange fees xOffset xSize $ do
+                  next
+                  assign (state . stack) (hash : xs)
+                  assign (env . sha3Crack . at hash) (Just bytes)
+            _ -> underrun
+
+        -- op: ADDRESS
+        0x30 ->
+          limitStack 1 $
+            burn g_base (next >> push (num (the state contract)))
+
+        -- op: BALANCE
+        0x31 ->
+          case stk of
+            (x:xs) -> do
+              burn g_balance $ do
+                touchAccount (num x) $ \c -> do
+                  next
+                  assign (state . stack) xs
+                  push (view balance c)
+            [] ->
+              underrun
+
+        -- op: ORIGIN
+        0x32 ->
+          limitStack 1 . burn g_base $
+            next >> push (num (the env origin))
+
+        -- op: CALLER
+        0x33 ->
+          limitStack 1 . burn g_base $
+            next >> push (num (the state caller))
+
+        -- op: CALLVALUE
+        0x34 ->
+          limitStack 1 . burn g_base $
+            next >> push (the state callvalue)
+
+        -- op: CALLDATALOAD
+        0x35 -> stackOp1 (const g_verylow) $
+          \x -> readBlobWord x (the state calldata)
+
+        -- op: CALLDATASIZE
+        0x36 ->
+          limitStack 1 . burn g_base $
+            next >> push (blobSize (the state calldata))
+
+        -- op: CALLDATACOPY
+        0x37 ->
+          case stk of
+            ((num -> xTo) : (num -> xFrom) : (num -> xSize) :xs) -> do
+              burn (g_verylow + g_copy * ceilDiv xSize 32) $ do
+                accessMemoryRange fees xTo xSize $ do
+                  next
+                  assign (state . stack) xs
+                  copyBytesToMemory (the state calldata) xSize xFrom xTo
+            _ -> underrun
+
+        -- op: CODESIZE
+        0x38 ->
+          limitStack 1 . burn g_base $
+            next >> push (num (BS.length (the state code)))
+
+        -- op: CODECOPY
+        0x39 ->
+          case stk of
+            ((num -> memOffset) : (num -> codeOffset) : (num -> n) : xs) -> do
+              burn (g_verylow + g_copy * ceilDiv (num n) 32) $ do
+                accessMemoryRange fees memOffset n $ do
+                  next
+                  assign (state . stack) xs
+                  copyBytesToMemory (blob (view bytecode this))
+                    n codeOffset memOffset
+            _ -> underrun
+
+        -- op: GASPRICE
+        0x3a ->
+          limitStack 1 . burn g_base $
+            next >> push (the block gasprice)
+
+        -- op: EXTCODESIZE
+        0x3b ->
+          case stk of
+            (x:xs) -> do
+              if x == num cheatCode
+                then do
+                  next
+                  assign (state . stack) xs
+                  push (w256 1)
+                else
+                  burn g_extcode $ do
+                    touchAccount (num x) $ \c -> do
+                      next
+                      assign (state . stack) xs
+                      push (num (view codesize c))
+            [] ->
+              underrun
+
+        -- op: EXTCODECOPY
+        0x3c ->
+          case stk of
+            ( extAccount
+              : (num -> memOffset)
+              : (num -> codeOffset)
+              : (num -> codeSize)
+              : xs ) -> do
+              burn (g_extcode + g_copy * ceilDiv (num codeSize) 32) $
+                accessMemoryRange fees memOffset codeSize $ do
+                  touchAccount (num extAccount) $ \c -> do
+                    next
+                    assign (state . stack) xs
+                    copyBytesToMemory (blob (view bytecode c))
+                      codeSize codeOffset memOffset
+            _ -> underrun
+
+        -- op: RETURNDATASIZE
+        0x3d ->
+          limitStack 1 . burn g_base $
+            next >> push (blobSize (the state returndata))
+
+        -- op: RETURNDATACOPY
+        0x3e ->
+          case stk of
+            ((num -> xTo) : (num -> xFrom) : (num -> xSize) :xs) -> do
+              burn (g_verylow + g_copy * ceilDiv xSize 32) $ do
+                accessMemoryRange fees xTo xSize $ do
+                  next
+                  assign (state . stack) xs
+                  copyBytesToMemory (the state returndata) xSize xFrom xTo
+            _ -> underrun
+
+        -- op: BLOCKHASH
+        0x40 -> do
+          -- We adopt the fake block hash scheme of the VMTests,
+          -- so that blockhash(i) is the hash of i as decimal ASCII.
+          stackOp1 (const g_blockhash) $
+            \i ->
+              if i + 256 < the block number || i >= the block number
+              then 0
+              else
+                (num i :: Integer)
+                  & show & Char8.pack & keccak & num
+
+        -- op: COINBASE
+        0x41 ->
+          limitStack 1 . burn g_base $
+            next >> push (num (the block coinbase))
+
+        -- op: TIMESTAMP
+        0x42 ->
+          limitStack 1 . burn g_base $
+            next >> push (the block timestamp)
+
+        -- op: NUMBER
+        0x43 ->
+          limitStack 1 . burn g_base $
+            next >> push (the block number)
+
+        -- op: DIFFICULTY
+        0x44 ->
+          limitStack 1 . burn g_base $
+            next >> push (the block difficulty)
+
+        -- op: GASLIMIT
+        0x45 ->
+          limitStack 1 . burn g_base $
+            next >> push (the block gaslimit)
+
+        -- op: POP
+        0x50 ->
+          case stk of
+            (_:xs) -> burn g_base (next >> assign (state . stack) xs)
+            _      -> underrun
+
+        -- op: MLOAD
+        0x51 ->
+          case stk of
+            (x:xs) -> do
+              burn g_verylow $
+                accessMemoryWord fees x $ do
+                  next
+                  assign (state . stack) (view (word256At (num x)) mem : xs)
+            _ -> underrun
+
+        -- op: MSTORE
+        0x52 ->
+          case stk of
+            (x:y:xs) -> do
+              burn g_verylow $
+                accessMemoryWord fees x $ do
+                  next
+                  assign (state . memory . word256At (num x)) y
+                  assign (state . stack) xs
+            _ -> underrun
+
+        -- op: MSTORE8
+        0x53 ->
+          case stk of
+            (x:y:xs) -> do
+              burn g_verylow $
+                accessMemoryRange fees x 1 $ do
+                  next
+                  modifying (state . memory) (setMemoryByte x (wordToByte y))
+                  assign (state . stack) xs
+            _ -> underrun
+
+        -- op: SLOAD
+        0x54 ->
+          case stk of
+            (x:xs) ->
+              burn g_sload $
+                accessStorage self x $ \y -> do
+                  next
+                  assign (state . stack) (y:xs)
+            _ -> underrun
+
+        -- op: SSTORE
+        0x55 ->
+          notStatic $
+          case stk of
+            (x:new:xs) -> do
+              accessStorage self x $ \old -> do
+                -- Gas cost is higher when changing from zero to nonzero.
+                let cost = if old == 0 && new /= 0 then g_sset else g_sreset
+
+                burn cost $ do
+                  next
+                  assign (state . stack) xs
+                  assign (env . contracts . ix (the state contract) . storage . at x)
+                    (Just new)
+
+                  -- Give gas refund if clearing the storage slot.
+                  if old /= 0 && new == 0 then refund r_sclear else noop
+
+            _ -> underrun
+
+        -- op: JUMP
+        0x56 ->
+          case stk of
+            (x:xs) -> do
+              burn g_mid $ do
+                checkJump x xs
+            _ -> underrun
+
+        -- op: JUMPI
+        0x57 -> do
+          case stk of
+            (x:y:xs) -> do
+              burn g_high $ do
+                if y == 0
+                  then assign (state . stack) xs >> next
+                  else checkJump x xs
+            _ -> underrun
+
+        -- op: PC
+        0x58 ->
+          limitStack 1 . burn g_base $
+            next >> push (num (the state pc))
+
+        -- op: MSIZE
+        0x59 ->
+          limitStack 1 . burn g_base $
+            next >> push (num (the state memorySize))
+
+        -- op: GAS
+        0x5a ->
+          limitStack 1 . burn g_base $
+            next >> push (the state gas - g_base)
+
+        -- op: JUMPDEST
+        0x5b -> burn g_jumpdest next
+
+        -- op: EXP
+        0x0a ->
+          let cost (_, exponent) =
+                if exponent == 0
+                then g_exp
+                else g_exp + g_expbyte * num (ceilDiv (1 + log2 exponent) 8)
+          in stackOp2 cost (uncurry exponentiate)
+
+        -- op: SIGNEXTEND
+        0x0b ->
+          stackOp2 (const g_low) $ \(bytes, x) ->
+            if bytes >= 32 then x
+            else let n = num bytes * 8 + 7 in
+              if testBit x n
+              then x .|. complement (bit n - 1)
+              else x .&. (bit n - 1)
+
+        -- op: CREATE
+        0xf0 ->
+          notStatic $
+          case stk of
+            (xValue:xOffset:xSize:xs) ->
+              burn g_create $ do
+                accessMemoryRange fees xOffset xSize $ do
+                  if xValue > view balance this
+                    then do
+                      assign (state . stack) (0 : xs)
+                      next
+                    else do
+                      let
+                        newAddr =
+                          newContractAddress self (forceConcreteWord (view nonce this))
+                      case view execMode vm of
+                        ExecuteAsVMTest -> do
+                          assign (state . stack) (num newAddr : xs)
+                          next
+
+                        ExecuteNormally -> do
+                          let
+                            newCode =
+                              forceConcreteBlob $ readMemory (num xOffset) (num xSize) vm
+                            newContract =
+                              initialContract newCode
+                            newContext  =
+                              CreationContext (view codehash newContract)
+
+                          zoom (env . contracts) $ do
+                            assign (at newAddr) (Just newContract)
+                            assign (ix newAddr . balance) xValue
+                            modifying (ix self . balance) (flip (-) xValue)
+                            modifying (ix self . nonce) succ
+
+                          pushTrace (FrameTrace newContext)
+                          next
+                          vm' <- get
+                          pushTo frames $ Frame
+                            { _frameContext = newContext
+                            , _frameState   = (set stack xs) (view state vm')
+                            }
+
+                          assign state $
+                            blankState
+                              & set contract   newAddr
+                              & set codeContract newAddr
+                              & set code       newCode
+                              & set callvalue  xValue
+                              & set caller     self
+                              & set gas        (view (state . gas) vm')
+
+            _ -> underrun
+
+        -- op: CALL
+        0xf1 ->
+          case stk of
+            ( xGas
+              : (num -> xTo)
+              : xValue
+              : xInOffset
+              : xInSize
+              : xOutOffset
+              : xOutSize
+              : xs
+             ) ->
+              case xTo of
+                n | n > 0 && n <= 8 -> precompiledContract
+                _ ->
+                  let
+                    availableGas = the state gas
+                    recipient    = view (env . contracts . at xTo) vm
+                    (cost, gas') = costOfCall fees recipient xValue availableGas xGas
+                  in burn (cost - gas') $
+                    (if xValue > 0 then notStatic else id) $
+                    if xValue > view balance this
+                    then do
+                      assign (state . stack) (0 : xs)
+                      next
+                    else
+                      case view execMode vm of
+                        ExecuteAsVMTest -> do
+                          assign (state . stack) (1 : xs)
+                          next
+                        ExecuteNormally -> do
+                          delegateCall fees gas' xTo xInOffset xInSize xOutOffset xOutSize xs $ do
+                            zoom state $ do
+                              assign callvalue xValue
+                              assign caller (the state contract)
+                              assign contract xTo
+                              assign memorySize 0
+                            zoom (env . contracts) $ do
+                              ix self . balance -= xValue
+                              ix xTo  . balance += xValue
+            _ ->
+              underrun
+
+        -- op: CALLCODE
+        0xf2 ->
+          error "CALLCODE not supported (use DELEGATECALL)"
+
+        -- op: RETURN
+        0xf3 ->
+          case stk of
+            (xOffset:xSize:_) ->
+              accessMemoryRange fees xOffset xSize $ do
+                case vm ^. frames of
+                  [] ->
+                    assign result (Just (VMSuccess (readMemory (num xOffset) (num xSize) vm)))
+
+                  (nextFrame : remainingFrames) -> do
+                    assign frames remainingFrames
+
+                    case view frameContext nextFrame of
+                      CreationContext _ -> do
+                        replaceCodeOfSelf (forceConcreteBlob (readMemory (num xOffset) (num xSize) vm))
+                        assign state (view frameState nextFrame)
+
+                        -- Move back the gas to the parent context
+                        assign (state . gas) (the state gas)
+
+                        push (num (the state contract))
+                        popTrace
+
+                      ctx@(CallContext yOffset ySize _ _ _ _) -> do
+                        let output = readMemory (num xOffset) (num xSize) vm
+                        assign state (view frameState nextFrame)
+
+                        -- Take back the remaining gas allowance
+                        modifying (state . gas) (+ the state gas)
+                        modifying burned (subtract (the state gas))
+
+                        assign (state . returndata) output
+                        copyBytesToMemory
+                          output
+                          (num ySize)
+                          0
+                          (num yOffset)
+                        push 1
+
+                        insertTrace (ReturnTrace output ctx)
+                        popTrace
+
+            _ -> underrun
+
+        -- op: DELEGATECALL
+        0xf4 ->
+          case stk of
+            (xGas:xTo:xInOffset:xInSize:xOutOffset:xOutSize:xs) ->
+              if num xTo == cheatCode
+              then do
+                assign (state . stack) xs
+                cheat (xInOffset, xInSize) (xOutOffset, xOutSize)
+              else
+                burn (num g_call) $ do
+                  delegateCall fees xGas (num xTo) xInOffset xInSize xOutOffset xOutSize xs
+                    (return ())
+            _ -> underrun
+
+        -- op: STATICCALL
+        0xfa ->
+          case stk of
+            (xGas : (num -> xTo) : xInOffset : xInSize : xOutOffset : xOutSize : xs) ->
+              case xTo of
+                n | n > 0 && n <= 8 -> precompiledContract
+                _ ->
+                  let
+                    availableGas = the state gas
+                    recipient    = view (env . contracts . at xTo) vm
+                    (cost, gas') = costOfCall fees recipient 0 availableGas xGas
+                  in burn (cost - gas') $
+                    case view execMode vm of
+                      ExecuteAsVMTest -> do
+                        assign (state . stack) (1 : xs)
+                        next
+                      ExecuteNormally -> do
+                        delegateCall fees gas' xTo xInOffset xInSize xOutOffset xOutSize xs $ do
+                          zoom state $ do
+                            assign callvalue 0
+                            assign caller (the state contract)
+                            assign contract xTo
+                            assign memorySize 0
+                            assign static True
+            _ ->
+              underrun
+
+        -- op: SELFDESTRUCT
+        0xff ->
+          notStatic $
+          case stk of
+            [] -> underrun
+            (x:_) -> do
+              touchAccount (num x) $ \_ -> do
+                pushTo (tx . selfdestructs) self
+                assign (env . contracts . ix self . balance) 0
+                modifying
+                  (env . contracts . ix (num x) . balance)
+                  (+ (vm ^?! env . contracts . ix self . balance))
+                doStop
+
+        -- op: REVERT
+        0xfd ->
+          vmError Revert
+
+        xxx ->
+          vmError (UnrecognizedOpcode xxx)
+
+precompiledContract :: (?op :: Word8) => EVM ()
+precompiledContract = do
+  vm <- get
+  fees <- use (block . schedule)
+
+  use (state . stack) >>= \case
+    (_:(num -> op):_:inOffset:inSize:outOffset:outSize:xs) ->
+      let
+        input = forceConcreteBlob (readMemory (num inOffset) (num inSize) vm)
+      in
+        case EVM.Precompiled.execute op input (num outSize) of
+          Nothing -> do
+            assign (state . stack) (0 : xs)
+            vmError (PrecompiledContractError op)
+          Just output -> do
+            let
+              cost =
+                case op of
+                  1 -> 3000
+                  _ -> error ("unimplemented precompiled contract " ++ show op)
+            accessMemoryRange fees inOffset inSize $
+              accessMemoryRange fees outOffset outSize $
+                burn cost $ do
+                  assign (state . stack) (1 : xs)
+                  modifying (state . memory)
+                    (writeMemory (blob output) outSize 0 outOffset)
+                  next
+    _ ->
+      underrun
+
+-- * Opcode helper actions
+
+noop :: Monad m => m ()
+noop = pure ()
+
+pushTo :: MonadState s m => ASetter s s [a] [a] -> a -> m ()
+pushTo f x = f %= (x :)
+
+pushToSequence :: MonadState s m => ASetter s s (Seq a) (Seq a) -> a -> m ()
+pushToSequence f x = f %= (Seq.|> x)
+
+touchAccount :: Addr -> (Contract -> EVM ()) -> EVM ()
+touchAccount addr continue = do
+  use (env . contracts . at addr) >>= \case
+    Just c -> continue c
+    Nothing ->
+      use (cache . fetched . at addr) >>= \case
+        Just c -> do
+          assign (env . contracts . at addr) (Just c)
+          continue c
+        Nothing ->
+          assign result . Just . VMFailure . Query $
+            PleaseFetchContract addr
+              (\c -> do assign (cache . fetched . at addr) (Just c)
+                        assign (env . contracts . at addr) (Just c)
+                        assign result Nothing
+                        continue c)
+
+accessStorage
+  :: Addr             -- ^ Contract address
+  -> Word             -- ^ Storage slot key
+  -> (Word -> EVM ()) -- ^ Continuation
+  -> EVM ()
+accessStorage addr slot continue =
+  use (env . contracts . at addr) >>= \case
+    Just c ->
+      case view (storage . at slot) c of
+        Just value ->
+          continue value
+        Nothing ->
+          if view external c
+          then
+            assign result . Just . VMFailure . Query $
+              PleaseFetchSlot addr slot
+                (\x -> do
+                    assign (cache . fetched . ix addr . storage . at slot) (Just x)
+                    assign (env . contracts . ix addr . storage . at slot) (Just x)
+                    assign result Nothing
+                    continue x)
+          else do
+            assign (env . contracts . ix addr . storage . at slot) (Just 0)
+            continue 0
+    Nothing ->
+      touchAccount addr $ \_ ->
+        accessStorage addr slot continue
+
+-- | Replace current contract's code, like when CREATE returns
+-- from the constructor code.
+replaceCodeOfSelf :: ByteString -> EVM ()
+replaceCodeOfSelf createdCode = do
+  self <- use (state . contract)
+  zoom (env . contracts . at self) $ do
+    if BS.null createdCode
+      then put Nothing
+      else do
+        Just now <- get
+        put . Just $
+          initialContract createdCode
+            & set storage (view storage now)
+            & set balance (view balance now)
+
+resetState :: EVM ()
+resetState = do
+  assign result     Nothing
+  assign frames     []
+  assign state      blankState
+
+finalize :: EVM ()
+finalize = do
+  destroyedAddresses <- use (tx . selfdestructs)
+  modifying (env . contracts)
+    (Map.filterWithKey (\k _ -> not (elem k destroyedAddresses)))
+
+loadContract :: Addr -> EVM ()
+loadContract target =
+  preuse (env . contracts . ix target . bytecode) >>=
+    \case
+      Nothing ->
+        error "Call target doesn't exist"
+      Just targetCode -> do
+        assign (state . contract) target
+        assign (state . code)     targetCode
+        assign (state . codeContract) target
+
+limitStack :: Int -> EVM () -> EVM ()
+limitStack n continue = do
+  stk <- use (state . stack)
+  if length stk + n > 1024
+    then vmError StackLimitExceeded
+    else continue
+
+notStatic :: EVM () -> EVM ()
+notStatic continue = do
+  bad <- use (state . static)
+  if bad
+    then vmError StateChangeWhileStatic
+    else continue
+
+burn :: Word -> EVM () -> EVM ()
+burn n continue = do
+  available <- use (state . gas)
+  if n <= available
+    then do
+      state . gas -= n
+      burned += n
+      continue
+    else
+      vmError (OutOfGas available n)
+
+refund :: Word -> EVM ()
+refund n = do
+  self <- use (state . contract)
+  pushTo (tx . refunds) (self, n)
+
+
+-- * Cheat codes
+
+-- The cheat code is 7109709ecfa91a80626ff3989d68f67f5b1dd12d.
+cheatCode :: Addr
+cheatCode = num (keccak "hevm cheat code")
+
+cheat
+  :: (?op :: Word8)
+  => (Word, Word) -> (Word, Word)
+  -> EVM ()
+cheat (inOffset, inSize) (outOffset, outSize) = do
+  mem <- use (state . memory)
+  let
+    abi =
+      num (forceConcreteWord (readMemoryWord32 inOffset mem))
+    input =
+      forceConcreteBlob (sliceMemory (inOffset + 4) (inSize - 4) mem)
+  case Map.lookup abi cheatActions of
+    Nothing ->
+      vmError (BadCheatCode abi)
+    Just (argTypes, action) -> do
+      case runGetOrFail
+             (getAbiSeq (length argTypes) argTypes)
+             (fromStrict input) of
+        Right ("", _, args) -> do
+          action (toList args) >>= \case
+            Nothing -> do
+              next
+              push 1
+            Just (encodeAbiValue -> bs) -> do
+              next
+              modifying (state . memory)
+                (writeMemory (blob bs) outSize 0 outOffset)
+              push 1
+        Left _ ->
+          vmError (BadCheatCode abi)
+        Right _ ->
+          vmError (BadCheatCode abi)
+
+type CheatAction = ([AbiType], [AbiValue] -> EVM (Maybe AbiValue))
+
+cheatActions :: Map Word32 CheatAction
+cheatActions =
+  Map.fromList
+    [ action "warp(uint256)" [AbiUIntType 256] $
+        \[AbiUInt 256 x] -> do
+          assign (block . timestamp) (w256 (W256 x))
+          return Nothing
+    ]
+  where
+    action s ts f = (abiKeccak s, (ts, f))
+
+
+-- * General call implementation ("delegateCall")
+
+delegateCall
+  :: (?op :: Word8)
+  => FeeSchedule Word
+  -> Word -> Addr -> Word -> Word -> Word -> Word -> [Word]
+  -> EVM ()
+  -> EVM ()
+delegateCall fees xGas xTo xInOffset xInSize xOutOffset xOutSize xs continue =
+  touchAccount xTo . const $
+    preuse (env . contracts . ix xTo) >>=
+      \case
+        Nothing -> vmError (NoSuchContract xTo)
+        Just target ->
+          accessMemoryRange fees xInOffset xInSize $ do
+            accessMemoryRange fees xOutOffset xOutSize $ do
+              burn xGas $ do
+                vm0 <- get
+
+                let newContext = CallContext
+                      { callContextOffset = xOutOffset
+                      , callContextSize = xOutSize
+                      , callContextCodehash = view codehash target
+                      , callContextReversion = view (env . contracts) vm0
+                      , callContextAbi =
+                          if xInSize >= 4
+                          then
+                            let
+                              w = forceConcreteWord
+                                    (readMemoryWord32 xInOffset (view (state . memory) vm0))
+                            in Just $! num w
+                          else Nothing
+                      , callContextData = (readMemory (num xInOffset) (num xInSize) vm0)
+                      }
+
+                pushTrace (FrameTrace newContext)
+                next
+                vm1 <- get
+
+                pushTo frames $ Frame
+                  { _frameState = (set stack xs) (view state vm1)
+                  , _frameContext = newContext
+                  }
+
+                zoom state $ do
+                  assign gas xGas
+                  assign pc 0
+                  assign code (view bytecode target)
+                  assign codeContract xTo
+                  assign stack mempty
+                  assign memory mempty
+                  assign calldata (readMemory (num xInOffset) (num xInSize) vm0)
+
+                continue
+
+
+-- * VM error implementation
+underrun :: EVM ()
+underrun = vmError StackUnderrun
+
+vmError :: Error -> EVM ()
+vmError e = do
+  vm <- get
+  case view frames vm of
+    [] -> assign result (Just (VMFailure e))
+
+    (nextFrame : remainingFrames) -> do
+
+      insertTrace (ErrorTrace e)
+      popTrace
+
+      case view frameContext nextFrame of
+        CreationContext _ -> do
+          assign frames remainingFrames
+          assign state (view frameState nextFrame)
+          assign (state . gas) 0
+          push 0
+          let self = vm ^. state . contract
+          assign (env . contracts . at self) Nothing
+
+        CallContext _ _ _ _ _ reversion -> do
+          assign frames remainingFrames
+          assign state (view frameState nextFrame)
+          assign (env . contracts) reversion
+          push 0
+
+
+-- * Memory helpers
+
+accessMemoryRange
+  :: FeeSchedule Word
+  -> Word
+  -> Word
+  -> EVM ()
+  -> EVM ()
+accessMemoryRange _ _ 0 continue = continue
+accessMemoryRange fees f l continue = do
+  m0 <- num <$> use (state . memorySize)
+  if f + l < l
+    then vmError IllegalOverflow
+    else do
+      let m1 = 32 * ceilDiv (max m0 (f + l)) 32
+      burn (memoryCost fees m1 - memoryCost fees m0) $ do
+        assign (state . memorySize) (num m1)
+        continue
+
+accessMemoryWord
+  :: FeeSchedule Word -> Word -> EVM () -> EVM ()
+accessMemoryWord fees x continue = accessMemoryRange fees x 32 continue
+
+copyBytesToMemory
+  :: Blob -> Word -> Word -> Word -> EVM ()
+copyBytesToMemory bs size xOffset yOffset =
+  if size == 0 then noop
+  else do
+    mem <- use (state . memory)
+    assign (state . memory) $
+      writeMemory bs size xOffset yOffset mem
+
+readMemory :: Word -> Word -> VM -> Blob
+readMemory offset size vm = sliceMemory offset size (view (state . memory) vm)
+
+word256At
+  :: Functor f
+  => Word -> (Word -> f Word)
+  -> Memory -> f Memory
+word256At i = lens getter setter where
+  getter m = readMemoryWord i m
+  setter m x = setMemoryWord i x m
+
+-- * Tracing
+
+withTraceLocation
+  :: (MonadState VM m) => TraceData -> m Trace
+withTraceLocation x = do
+  vm <- get
+  let
+    Just this =
+      preview (env . contracts . ix (view (state . codeContract) vm)) vm
+  pure Trace
+    { _traceData = x
+    , _traceCodehash = view codehash this
+    , _traceOpIx = (view opIxMap this) Vector.! (view (state . pc) vm)
+    }
+
+pushTrace :: TraceData -> EVM ()
+pushTrace x = do
+  trace <- withTraceLocation x
+  modifying traces $
+    \t -> Zipper.children $ Zipper.insert (Node trace []) t
+
+insertTrace :: TraceData -> EVM ()
+insertTrace x = do
+  trace <- withTraceLocation x
+  modifying traces $
+    \t -> Zipper.nextSpace $ Zipper.insert (Node trace []) t
+
+popTrace :: EVM ()
+popTrace =
+  modifying traces $
+    \t -> case Zipper.parent t of
+            Nothing -> error "internal error (trace root)"
+            Just t' -> Zipper.nextSpace t'
+
+zipperRootForest :: Zipper.TreePos Zipper.Empty a -> Forest a
+zipperRootForest z =
+  case Zipper.parent z of
+    Nothing -> Zipper.toForest z
+    Just z' -> zipperRootForest (Zipper.nextSpace z')
+
+traceForest :: VM -> Forest Trace
+traceForest vm =
+  view (traces . to zipperRootForest) vm
+
+traceLog :: (MonadState VM m) => Log -> m ()
+traceLog log = do
+  trace <- withTraceLocation (EventTrace log)
+  modifying traces $
+    \t -> Zipper.nextSpace (Zipper.insert (Node trace []) t)
+
+-- * Stack manipulation
+
+push :: Word -> EVM ()
+push x = state . stack %= (x :)
+
+stackOp1
+  :: (?op :: Word8)
+  => (Word -> Word)
+  -> (Word -> Word)
+  -> EVM ()
+stackOp1 cost f =
+  use (state . stack) >>= \case
+    (x:xs) ->
+      burn (cost x) $ do
+        next
+        let !y = f x
+        state . stack .= y : xs
+    _ ->
+      underrun
+
+stackOp2
+  :: (?op :: Word8)
+  => ((Word, Word) -> Word)
+  -> ((Word, Word) -> Word)
+  -> EVM ()
+stackOp2 cost f =
+  use (state . stack) >>= \case
+    (x:y:xs) ->
+      burn (cost (x, y)) $ do
+        next
+        state . stack .= f (x, y) : xs
+    _ ->
+      underrun
+
+stackOp3
+  :: (?op :: Word8)
+  => ((Word, Word, Word) -> Word)
+  -> ((Word, Word, Word) -> Word)
+  -> EVM ()
+stackOp3 cost f =
+  use (state . stack) >>= \case
+    (x:y:z:xs) ->
+      burn (cost (x, y, z)) $ do
+        next
+        state . stack .= f (x, y, z) : xs
+    _ ->
+      underrun
+
+-- * Bytecode data functions
+
+checkJump :: (Integral n) => n -> [Word] -> EVM ()
+checkJump x xs = do
+  theCode <- use (state . code)
+  if x < num (BS.length theCode) && BS.index theCode (num x) == 0x5b
+    then
+      insidePushData (num x) >>=
+        \case
+          True ->
+            vmError BadJumpDestination
+          _ -> do
+            state . stack .= xs
+            state . pc .= num x
+    else vmError BadJumpDestination
+
+insidePushData :: Int -> EVM Bool
+insidePushData i =
+  -- If the operation index for the code pointer is the same
+  -- as for the previous code pointer, then it's inside push data.
+  if i == 0
+    then pure False
+    else do
+      self <- use (state . codeContract)
+      Just x <- preuse (env . contracts . ix self . opIxMap)
+      pure ((x Vector.! i) == (x Vector.! (i - 1)))
+
+opSize :: Word8 -> Int
+opSize x | x >= 0x60 && x <= 0x7f = num x - 0x60 + 2
+opSize _                          = 1
+
+-- Index i of the resulting vector contains the operation index for
+-- the program counter value i.  This is needed because source map
+-- entries are per operation, not per byte.
+mkOpIxMap :: ByteString -> Vector Int
+mkOpIxMap xs = Vector.create $ Vector.new (BS.length xs) >>= \v ->
+  -- Loop over the byte string accumulating a vector-mutating action.
+  -- This is somewhat obfuscated, but should be fast.
+  let (_, _, _, m) =
+        BS.foldl' (go v) (0 :: Word8, 0, 0, return ()) xs
+  in m >> return v
+  where
+    go v (0, !i, !j, !m) x | x >= 0x60 && x <= 0x7f =
+      {- Start of PUSH op. -} (x - 0x60 + 1, i + 1, j,     m >> Vector.write v i j)
+    go v (1, !i, !j, !m) _ =
+      {- End of PUSH op. -}   (0,            i + 1, j + 1, m >> Vector.write v i j)
+    go v (0, !i, !j, !m) _ =
+      {- Other op. -}         (0,            i + 1, j + 1, m >> Vector.write v i j)
+    go v (n, !i, !j, !m) _ =
+      {- PUSH data. -}        (n - 1,        i + 1, j,     m >> Vector.write v i j)
+
+vmOp :: VM -> Maybe Op
+vmOp vm =
+  let i  = vm ^. state . pc
+      xs = BS.drop i (vm ^. state . code)
+      op = BS.index xs 0
+  in if BS.null xs
+     then Nothing
+     else Just (readOp op (BS.drop 1 xs))
+
+vmOpIx :: VM -> Maybe Int
+vmOpIx vm =
+  do self <- currentContract vm
+     (view opIxMap self) Vector.!? (view (state . pc) vm)
+
+opParams :: VM -> Map String Word
+opParams vm =
+  case vmOp vm of
+    Just OpCreate ->
+      params $ words "value offset size"
+    Just OpCall ->
+      params $ words "gas to value in-offset in-size out-offset out-size"
+    Just OpSstore ->
+      params $ words "index value"
+    Just OpCodecopy ->
+      params $ words "mem-offset code-offset code-size"
+    Just OpSha3 ->
+      params $ words "offset size"
+    Just OpCalldatacopy ->
+      params $ words "to from size"
+    Just OpExtcodecopy ->
+      params $ words "account mem-offset code-offset code-size"
+    Just OpReturn ->
+      params $ words "offset size"
+    Just OpJumpi ->
+      params $ words "destination condition"
+    _ -> mempty
+  where
+    params xs =
+      if length (vm ^. state . stack) >= length xs
+      then Map.fromList (zip xs (vm ^. state . stack))
+      else mempty
+
+readOp :: Word8 -> ByteString -> Op
+readOp x _  | x >= 0x80 && x <= 0x8f = OpDup (x - 0x80 + 1)
+readOp x _  | x >= 0x90 && x <= 0x9f = OpSwap (x - 0x90 + 1)
+readOp x _  | x >= 0xa0 && x <= 0xa4 = OpLog (x - 0xa0)
+readOp x xs | x >= 0x60 && x <= 0x7f =
+  let n   = x - 0x60 + 1
+      xs' = BS.take (num n) xs
+  in OpPush (word xs')
+readOp x _ = case x of
+  0x00 -> OpStop
+  0x01 -> OpAdd
+  0x02 -> OpMul
+  0x03 -> OpSub
+  0x04 -> OpDiv
+  0x05 -> OpSdiv
+  0x06 -> OpMod
+  0x07 -> OpSmod
+  0x08 -> OpAddmod
+  0x09 -> OpMulmod
+  0x0a -> OpExp
+  0x0b -> OpSignextend
+  0x10 -> OpLt
+  0x11 -> OpGt
+  0x12 -> OpSlt
+  0x13 -> OpSgt
+  0x14 -> OpEq
+  0x15 -> OpIszero
+  0x16 -> OpAnd
+  0x17 -> OpOr
+  0x18 -> OpXor
+  0x19 -> OpNot
+  0x1a -> OpByte
+  0x20 -> OpSha3
+  0x30 -> OpAddress
+  0x31 -> OpBalance
+  0x32 -> OpOrigin
+  0x33 -> OpCaller
+  0x34 -> OpCallvalue
+  0x35 -> OpCalldataload
+  0x36 -> OpCalldatasize
+  0x37 -> OpCalldatacopy
+  0x38 -> OpCodesize
+  0x39 -> OpCodecopy
+  0x3a -> OpGasprice
+  0x3b -> OpExtcodesize
+  0x3c -> OpExtcodecopy
+  0x3d -> OpReturndatasize
+  0x3e -> OpReturndatacopy
+  0x40 -> OpBlockhash
+  0x41 -> OpCoinbase
+  0x42 -> OpTimestamp
+  0x43 -> OpNumber
+  0x44 -> OpDifficulty
+  0x45 -> OpGaslimit
+  0x50 -> OpPop
+  0x51 -> OpMload
+  0x52 -> OpMstore
+  0x53 -> OpMstore8
+  0x54 -> OpSload
+  0x55 -> OpSstore
+  0x56 -> OpJump
+  0x57 -> OpJumpi
+  0x58 -> OpPc
+  0x59 -> OpMsize
+  0x5a -> OpGas
+  0x5b -> OpJumpdest
+  0xf0 -> OpCreate
+  0xf1 -> OpCall
+  0xf2 -> OpCallcode
+  0xf3 -> OpReturn
+  0xf4 -> OpDelegatecall
+  0xfd -> OpRevert
+  0xff -> OpSelfdestruct
+  _    -> (OpUnknown x)
+
+mkCodeOps :: ByteString -> RegularVector.Vector (Int, Op)
+mkCodeOps bytes = RegularVector.fromList . toList $ go 0 bytes
+  where
+    go !i !xs =
+      case BS.uncons xs of
+        Nothing ->
+          mempty
+        Just (x, xs') ->
+          let j = opSize x
+          in (i, readOp x xs') Seq.<| go (i + j) (BS.drop j xs)
+
+-- * Gas cost calculation helpers
+
+-- Gas cost function for CALL, transliterated from the Yellow Paper.
+costOfCall
+  :: FeeSchedule Word
+  -> Maybe a -> Word -> Word -> Word
+  -> (Word, Word)
+costOfCall (FeeSchedule {..}) recipient xValue availableGas xGas =
+  (c_gascap + c_extra, c_callgas)
+  where
+    c_extra =
+      num g_call + c_xfer + c_new
+    c_xfer =
+      if xValue /= 0          then num g_callvalue              else 0
+    c_new =
+      if isNothing recipient  then num g_newaccount             else 0
+    c_callgas =
+      if xValue /= 0          then c_gascap + num g_callstipend else c_gascap
+    c_gascap =
+      if availableGas >= c_extra
+      then min xGas (allButOne64th (availableGas - c_extra))
+      else xGas
+
+memoryCost :: FeeSchedule Word -> Word -> Word
+memoryCost FeeSchedule{..} byteCount =
+  let
+    wordCount = ceilDiv byteCount 32
+    linearCost = g_memory * wordCount
+    quadraticCost = div (wordCount * wordCount) 512
+  in
+    if byteCount > exponentiate 2 32
+    then maxBound
+    else linearCost + quadraticCost
+
+-- * Arithmetic
+
+ceilDiv :: (Num a, Integral a) => a -> a -> a
+ceilDiv m n = div (m + n - 1) n
+
+allButOne64th :: (Num a, Integral a) => a -> a
+allButOne64th n = n - div n 64
+
+log2 :: FiniteBits b => b -> Int
+log2 x = finiteBitSize x - 1 - countLeadingZeros x
+
+
+-- * Emacs setup
+
+-- Local Variables:
+-- outline-regexp: "-- \\*+\\|data \\|newtype \\|type \\| +-- op: "
+-- outline-heading-alist:
+--   (("-- *" . 1) ("data " . 2) ("newtype " . 2) ("type " . 2))
+-- compile-command: "make"
+-- End:
diff --git a/src/EVM/ABI.hs b/src/EVM/ABI.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/ABI.hs
@@ -0,0 +1,413 @@
+{-
+
+  The ABI encoding is mostly straightforward.
+
+  Definition: an int-like value is an uint, int, boolean, or address.
+
+  Basic encoding:
+
+    * Int-likes and length prefixes are big-endian.
+    * All values are right-0-padded to multiples of 256 bits.
+      - Bytestrings are padded as a whole; e.g., bytes[33] takes 64 bytes.
+    * Dynamic-length sequences are prefixed with their length.
+
+  Sequences are encoded as a head followed by a tail, thus:
+
+    * the tail is the concatenation of encodings of non-int-like items.
+    * the head has 256 bits per sequence item, thus:
+      - int-likes are stored directly;
+      - non-int-likes are stored as byte offsets into the tail,
+          starting from the beginning of the head.
+
+  Nested sequences are encoded recursively with no special treatment.
+
+  Calldata args are encoded as heterogenous sequences sans length prefix.
+
+-}
+
+{-# Language DeriveAnyClass #-}
+{-# Language StrictData #-}
+{-# Language TemplateHaskell #-}
+
+module EVM.ABI
+  ( AbiValue (..)
+  , AbiType (..)
+  , Event (..)
+  , Anonymity (..)
+  , Indexed (..)
+  , putAbi
+  , getAbi
+  , getAbiSeq
+  , abiValueType
+  , abiTypeSolidity
+  , abiCalldata
+  , encodeAbiValue
+  , parseTypeName
+  ) where
+
+import EVM.Keccak (abiKeccak)
+import EVM.Types ()
+
+import Control.Monad      (replicateM, replicateM_, forM_, void)
+import Data.Binary.Get    (Get, label, getWord8, getWord32be, skip)
+import Data.Binary.Put    (Put, runPut, putWord8, putWord32be)
+import Data.Bits          (shiftL, shiftR, (.&.))
+import Data.ByteString    (ByteString)
+import Data.DoubleWord    (Word256, Int256, Word160, signedWord)
+import Data.Monoid        ((<>))
+import Data.Text          (Text, pack)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Vector        (Vector)
+import Data.Word          (Word32, Word8)
+import GHC.Generics
+
+import Test.QuickCheck hiding ((.&.), label)
+
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BSLazy
+import qualified Data.Text            as Text
+import qualified Data.Vector          as Vector
+
+import qualified Text.Megaparsec      as P
+import qualified Text.Megaparsec.Char as P
+
+data AbiValue
+  = AbiUInt         Int Word256
+  | AbiInt          Int Int256
+  | AbiAddress      Word160
+  | AbiBool         Bool
+  | AbiBytes        Int BS.ByteString
+  | AbiBytesDynamic BS.ByteString
+  | AbiString       BS.ByteString
+  | AbiArrayDynamic AbiType (Vector AbiValue)
+  | AbiArray        Int AbiType (Vector AbiValue)
+  deriving (Show, Read, Eq, Ord, Generic)
+
+data AbiType
+  = AbiUIntType         Int
+  | AbiIntType          Int
+  | AbiAddressType
+  | AbiBoolType
+  | AbiBytesType        Int
+  | AbiBytesDynamicType
+  | AbiStringType
+  | AbiArrayDynamicType AbiType
+  | AbiArrayType        Int AbiType
+  deriving (Show, Read, Eq, Ord, Generic)
+
+data AbiKind = Dynamic | Static
+  deriving (Show, Read, Eq, Ord, Generic)
+
+data Anonymity = Anonymous | NotAnonymous
+  deriving (Show, Ord, Eq, Generic)
+data Indexed   = Indexed   | NotIndexed
+  deriving (Show, Ord, Eq, Generic)
+data Event     = Event Text Anonymity [(AbiType, Indexed)]
+  deriving (Show, Ord, Eq, Generic)
+
+abiKind :: AbiType -> AbiKind
+abiKind = \case
+  AbiBytesDynamicType   -> Dynamic
+  AbiStringType         -> Dynamic
+  AbiArrayDynamicType _ -> Dynamic
+  AbiArrayType _ t      -> abiKind t
+  _                     -> Static
+
+abiValueType :: AbiValue -> AbiType
+abiValueType = \case
+  AbiUInt n _         -> AbiUIntType n
+  AbiInt n _          -> AbiIntType  n
+  AbiAddress _        -> AbiAddressType
+  AbiBool _           -> AbiBoolType
+  AbiBytes n _        -> AbiBytesType n
+  AbiBytesDynamic _   -> AbiBytesDynamicType
+  AbiString _         -> AbiStringType
+  AbiArrayDynamic t _ -> AbiArrayDynamicType t
+  AbiArray n t _      -> AbiArrayType n t
+
+abiTypeSolidity :: AbiType -> Text
+abiTypeSolidity = \case
+  AbiUIntType n         -> "uint" <> pack (show n)
+  AbiIntType n          -> "int" <> pack (show n)
+  AbiAddressType        -> "address"
+  AbiBoolType           -> "bool"
+  AbiBytesType n        -> "bytes" <> pack (show n)
+  AbiBytesDynamicType   -> "bytes"
+  AbiStringType         -> "string"
+  AbiArrayDynamicType t -> abiTypeSolidity t <> "[]"
+  AbiArrayType n t      -> abiTypeSolidity t <> "[" <> pack (show n) <> "]"
+
+getAbi :: AbiType -> Get AbiValue
+getAbi t = label (Text.unpack (abiTypeSolidity t)) $
+  case t of
+    AbiUIntType n  -> do
+      let word32Count = 8 * div (n + 255) 256
+      xs <- replicateM word32Count getWord32be
+      pure (AbiUInt n (pack32 word32Count xs))
+
+    AbiIntType n   -> asUInt n (AbiInt n)
+    AbiAddressType -> asUInt 256 AbiAddress
+    AbiBoolType    -> asUInt 256 (AbiBool . (== (1 :: Int)))
+
+    AbiBytesType n ->
+      AbiBytes n <$> getBytesWith256BitPadding n
+
+    AbiBytesDynamicType ->
+      AbiBytesDynamic <$>
+        (label "bytes length prefix" getWord256
+          >>= label "bytes data" . getBytesWith256BitPadding)
+
+    AbiStringType -> do
+      AbiBytesDynamic x <- getAbi AbiBytesDynamicType
+      pure (AbiString x)
+
+    AbiArrayType n t' ->
+      AbiArray n t' <$> getAbiSeq n (repeat t')
+
+    AbiArrayDynamicType t' -> do
+      AbiUInt _ n <- label "array length" (getAbi (AbiUIntType 256))
+      AbiArrayDynamic t' <$>
+        label "array body" (getAbiSeq (fromIntegral n) (repeat t'))
+
+putAbi :: AbiValue -> Put
+putAbi = \case
+  AbiUInt n x -> do
+    let word32Count = div (roundTo256Bits n) 4
+    forM_ (reverse [0 .. word32Count - 1]) $ \i ->
+      putWord32be (fromIntegral (shiftR x (i * 32) .&. 0xffffffff))
+
+  AbiInt n x   -> putAbi (AbiUInt n (fromIntegral x))
+  AbiAddress x -> putAbi (AbiUInt 160 (fromIntegral x))
+  AbiBool x    -> putAbi (AbiUInt 8 (if x then 1 else 0))
+
+  AbiBytes n xs -> do
+    forM_ [0 .. n-1] (putWord8 . BS.index xs)
+    replicateM_ (roundTo256Bits n - n) (putWord8 0)
+
+  AbiBytesDynamic xs -> do
+    let n = BS.length xs
+    putAbi (AbiUInt 256 (fromIntegral n))
+    putAbi (AbiBytes n xs)
+
+  AbiString s ->
+    putAbi (AbiBytesDynamic s)
+
+  AbiArray _ _ xs ->
+    putAbiSeq xs
+
+  AbiArrayDynamic _ xs -> do
+    putAbi (AbiUInt 256 (fromIntegral (Vector.length xs)))
+    putAbiSeq xs
+
+getAbiSeq :: Int -> [AbiType] -> Get (Vector AbiValue)
+getAbiSeq n ts = label "sequence" $ do
+  hs <- label "sequence head" (getAbiHead n ts)
+  Vector.fromList <$>
+    label "sequence tail" (mapM (either getAbi pure) hs)
+
+getAbiHead :: Int -> [AbiType]
+  -> Get [Either AbiType AbiValue]
+getAbiHead 0 _      = pure []
+getAbiHead _ []     = fail "ran out of types"
+getAbiHead n (t:ts) = do
+  case abiKind t of
+    Dynamic ->
+      (Left t :) <$> (skip 32 *> getAbiHead (n - 1) ts)
+    Static ->
+      do x  <- getAbi t
+         xs <- getAbiHead (n - 1) ts
+         pure (Right x : xs)
+
+putAbiTail :: AbiValue -> Put
+putAbiTail x =
+  case abiKind (abiValueType x) of
+    Static  -> pure ()
+    Dynamic -> putAbi x
+
+abiValueSize :: AbiValue -> Int
+abiValueSize x =
+  case x of
+    AbiUInt n _  -> roundTo256Bits n
+    AbiInt  n _  -> roundTo256Bits n
+    AbiBytes n _ -> roundTo256Bits n
+    AbiAddress _ -> 32
+    AbiBool _    -> 32
+    AbiArray _ _ xs -> Vector.sum (Vector.map abiHeadSize xs) +
+                       Vector.sum (Vector.map abiTailSize xs)
+    AbiBytesDynamic xs -> 32 + roundTo256Bits (BS.length xs)
+    AbiArrayDynamic _ xs -> 32 + Vector.sum (Vector.map abiHeadSize xs) +
+                                Vector.sum (Vector.map abiTailSize xs)
+    AbiString s -> 32 + roundTo256Bits (BS.length s)
+
+abiTailSize :: AbiValue -> Int
+abiTailSize x =
+  case abiKind (abiValueType x) of
+    Static -> 0
+    Dynamic ->
+      case x of
+        AbiString s -> 32 + roundTo256Bits (BS.length s)
+        AbiBytesDynamic s -> 32 + roundTo256Bits (BS.length s)
+        AbiArrayDynamic _ xs -> 32 + Vector.sum (Vector.map abiValueSize xs)
+        AbiArray _ _ xs -> Vector.sum (Vector.map abiValueSize xs)
+        _ -> error "impossible"
+
+abiHeadSize :: AbiValue -> Int
+abiHeadSize x =
+  case abiKind (abiValueType x) of
+    Dynamic -> 32
+    Static ->
+      case x of
+        AbiUInt n _  -> roundTo256Bits n
+        AbiInt  n _  -> roundTo256Bits n
+        AbiBytes n _ -> roundTo256Bits n
+        AbiAddress _ -> 32
+        AbiBool _    -> 32
+        AbiArray _ _ xs -> Vector.sum (Vector.map abiHeadSize xs) +
+                           Vector.sum (Vector.map abiTailSize xs)
+        AbiBytesDynamic _ -> 32
+        AbiArrayDynamic _ _ -> 32
+        AbiString _       -> 32
+
+putAbiSeq :: Vector AbiValue -> Put
+putAbiSeq xs =
+  do snd $ Vector.foldl' f (headSize, pure ()) (Vector.zip xs tailSizes)
+     Vector.sequence_ (Vector.map putAbiTail xs)
+  where
+    headSize = Vector.sum $ Vector.map abiHeadSize xs
+    tailSizes = Vector.map abiTailSize xs
+    f (i, m) (x, j) =
+      case abiKind (abiValueType x) of
+        Static -> (i, m >> putAbi x)
+        Dynamic -> (i + j, m >> putAbi (AbiUInt 256 (fromIntegral i)))
+
+encodeAbiValue :: AbiValue -> BS.ByteString
+encodeAbiValue = BSLazy.toStrict . runPut . putAbi
+
+abiCalldata :: Text -> Vector AbiValue -> BS.ByteString
+abiCalldata s xs = BSLazy.toStrict . runPut $ do
+  putWord32be (abiKeccak (encodeUtf8 s))
+  putAbiSeq xs
+
+parseTypeName :: Text -> Maybe AbiType
+parseTypeName = P.parseMaybe typeWithArraySuffix
+
+typeWithArraySuffix :: P.Parsec () Text AbiType
+typeWithArraySuffix = do
+  base <- basicType
+  sizes <-
+    P.many $
+      P.between
+        (P.char '[') (P.char ']')
+        (P.many P.digitChar)
+
+  let
+    parseSize :: AbiType -> [Char] -> AbiType
+    parseSize t "" = AbiArrayDynamicType t
+    parseSize t s  = AbiArrayType (read s) t
+
+  pure (foldl parseSize base sizes)
+
+basicType :: P.Parsec () Text AbiType
+basicType =
+  P.choice
+    [ P.string "address" *> pure AbiAddressType
+    , P.string "bool"    *> pure AbiBoolType
+    , P.string "string"  *> pure AbiStringType
+
+    , sizedType "uint" AbiUIntType
+    , sizedType "int"  AbiIntType
+    , sizedType "bytes" AbiBytesType
+
+    , P.string "bytes" *> pure AbiBytesDynamicType
+    ]
+
+  where
+    sizedType :: Text -> (Int -> AbiType) -> P.Parsec () Text AbiType
+    sizedType s f = P.try $ do
+      void (P.string s)
+      fmap (f . read) (P.some P.digitChar)
+
+pack32 :: Int -> [Word32] -> Word256
+pack32 n xs =
+  sum [ shiftL x ((n - i) * 32)
+      | (x, i) <- zip (map fromIntegral xs) [1..] ]
+
+pack8 :: Int -> [Word8] -> Word256
+pack8 n xs =
+  sum [ shiftL x ((n - i) * 8)
+      | (x, i) <- zip (map fromIntegral xs) [1..] ]
+
+asUInt :: Integral i => Int -> (i -> a) -> Get a
+asUInt n f = (\(AbiUInt _ x) -> f (fromIntegral x)) <$> getAbi (AbiUIntType n)
+
+getWord256 :: Get Word256
+getWord256 = pack32 8 <$> replicateM 8 getWord32be
+
+roundTo256Bits :: Integral a => a -> a
+roundTo256Bits n = 32 * div (n + 255) 256
+
+getBytesWith256BitPadding :: Integral a => a -> Get ByteString
+getBytesWith256BitPadding i =
+  (BS.pack <$> replicateM n getWord8)
+    <* skip ((roundTo256Bits n) - n)
+  where n = fromIntegral i
+
+-- QuickCheck instances
+
+genAbiValue :: AbiType -> Gen AbiValue
+genAbiValue = \case
+   AbiUIntType n -> genUInt n
+   AbiIntType n ->
+     do AbiUInt _ x <- genUInt n
+        b <- arbitrary
+        pure $ AbiInt n (signedWord x * if b then 1 else -1)
+   AbiAddressType ->
+     (\(AbiUInt _ x) -> AbiAddress (fromIntegral x)) <$> genUInt 20
+   AbiBoolType ->
+     elements [AbiBool False, AbiBool True]
+   AbiBytesType n ->
+     do xs <- replicateM n arbitrary
+        pure (AbiBytes n (BS.pack xs))
+   AbiBytesDynamicType ->
+     AbiBytesDynamic . BS.pack <$> listOf arbitrary
+   AbiStringType ->
+     AbiString . BS.pack <$> listOf arbitrary
+   AbiArrayDynamicType t ->
+     do xs <- listOf1 (scale (`div` 2) (genAbiValue t))
+        pure (AbiArrayDynamic t (Vector.fromList xs))
+   AbiArrayType n t ->
+     AbiArray n t . Vector.fromList <$>
+       replicateM n (scale (`div` 2) (genAbiValue t))
+  where
+    genUInt n =
+       do x <- pack8 (div n 8) <$> replicateM n arbitrary
+          pure . AbiUInt n $
+            if n == 256 then x else mod x (2 ^ n)
+
+instance Arbitrary AbiType where
+  arbitrary = oneof
+    [ (AbiUIntType . (* 8)) <$> choose (1, 32)
+    , (AbiIntType . (* 8)) <$> choose (1, 32)
+    , pure AbiAddressType
+    , pure AbiBoolType
+    , AbiBytesType . getPositive <$> arbitrary
+    , pure AbiBytesDynamicType
+    , pure AbiStringType
+    , AbiArrayDynamicType <$> scale (`div` 2) arbitrary
+    , AbiArrayType
+        <$> (getPositive <$> arbitrary)
+        <*> scale (`div` 2) arbitrary
+    ]
+
+instance Arbitrary AbiValue where
+  arbitrary = arbitrary >>= genAbiValue
+  shrink = \case
+    AbiArrayDynamic t v ->
+      Vector.toList v ++
+        map (AbiArrayDynamic t . Vector.fromList)
+            (shrinkList shrink (Vector.toList v))
+    AbiArray _ t v ->
+      Vector.toList v ++
+        map (\x -> AbiArray (length x) t (Vector.fromList x))
+            (shrinkList shrink (Vector.toList v))
+    _ -> []
diff --git a/src/EVM/Concrete.hs b/src/EVM/Concrete.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Concrete.hs
@@ -0,0 +1,252 @@
+{-# Language FlexibleInstances #-}
+{-# Language StandaloneDeriving #-}
+{-# Language StrictData #-}
+
+module EVM.Concrete where
+
+import Prelude hiding (Word, (^))
+
+import EVM.Types (W256 (..), num, toWord512, fromWord512)
+import EVM.Types (word, padRight, byteAt)
+import EVM.Keccak (keccak)
+
+import Control.Lens    ((^?), ix)
+import Data.Bits       (Bits (..), FiniteBits (..))
+import Data.ByteString (ByteString)
+import Data.DoubleWord (signedWord, unsignedWord)
+import Data.Maybe      (fromMaybe)
+import Data.Monoid     ((<>))
+import Data.String     (IsString)
+import Data.Word       (Word8)
+
+import qualified Data.ByteString as BS
+
+wordAt :: Int -> ByteString -> W256
+wordAt i bs =
+  word (padRight 32 (BS.drop i bs))
+
+word256Bytes :: W256 -> ByteString
+word256Bytes x = BS.pack [byteAt x (31 - i) | i <- [0..31]]
+
+readByteOrZero :: Int -> ByteString -> Word8
+readByteOrZero i bs = fromMaybe 0 (bs ^? ix i)
+
+byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString
+byteStringSliceWithDefaultZeroes offset size bs =
+  if size == 0
+  then ""
+  else
+    let bs' = BS.take size (BS.drop offset bs)
+    in bs' <> BS.replicate (size - BS.length bs') 0
+
+data Whiff = Dull | FromKeccak ByteString
+  deriving Show
+
+w256 :: W256 -> Word
+w256 = C Dull
+
+blob :: ByteString -> Blob
+blob = B
+
+data Word = C Whiff W256
+newtype Blob = B ByteString
+newtype Byte = ConcreteByte Word8
+newtype Memory = ConcreteMemory ByteString
+
+wordToByte :: Word -> Byte
+wordToByte (C _ x) = ConcreteByte (num (x .&. 0xff))
+
+exponentiate :: Word -> Word -> Word
+exponentiate (C _ x) (C _ y) = w256 (x ^ y)
+
+sdiv :: Word -> Word -> Word
+sdiv _ (C _ (W256 0)) = 0
+sdiv (C _ (W256 x)) (C _ (W256 y)) =
+  let sx = signedWord x
+      sy = signedWord y
+  in w256 . W256 . unsignedWord $ quot sx sy
+
+smod :: Word -> Word -> Word
+smod _ (C _ (W256 0)) = 0
+smod (C _ (W256 x)) (C _ (W256 y)) =
+  let sx = signedWord x
+      sy = signedWord y
+  in w256 . W256 . unsignedWord $ rem sx sy
+
+addmod :: Word -> Word -> Word -> Word
+addmod _ _ (C _ (W256 0)) = 0
+addmod (C _ x) (C _ y) (C _ z) =
+  w256 $
+    fromWord512
+      ((toWord512 x + toWord512 y) `mod` (toWord512 z))
+
+mulmod :: Word -> Word -> Word -> Word
+mulmod _ _ (C _ (W256 0)) = 0
+mulmod (C _ x) (C _ y) (C _ z) =
+  w256 $
+    fromWord512
+      ((toWord512 x * toWord512 y) `mod` (toWord512 z))
+
+slt :: Word -> Word -> Word
+slt (C _ (W256 x)) (C _ (W256 y)) =
+  if signedWord x < signedWord y then w256 1 else w256 0
+
+sgt :: Word -> Word -> Word
+sgt (C _ (W256 x)) (C _ (W256 y)) =
+  if signedWord x > signedWord y then w256 1 else w256 0
+
+forceConcreteBlob :: Blob -> ByteString
+forceConcreteBlob (B x) = x
+
+forceConcreteWord :: Word -> W256
+forceConcreteWord (C _ x) = x
+
+sliceMemory :: (Integral a, Integral b) => a -> b -> Memory -> Blob
+sliceMemory o s (ConcreteMemory m) =
+  B $ byteStringSliceWithDefaultZeroes (num o) (num s) m
+
+writeMemory :: Blob -> Word -> Word -> Word -> Memory -> Memory
+writeMemory (B bs1) (C _ n) (C _ src) (C _ dst) (ConcreteMemory bs0) =
+  if src > num (BS.length bs1)
+  then
+    let
+      (a, b) = BS.splitAt (num dst) bs0
+      c      = BS.replicate (num n) 0
+      b'     = BS.drop (num n) b
+    in
+      ConcreteMemory $
+        a <> c <> b'
+  else
+    let
+      (a, b) = BS.splitAt (num dst) bs0
+      c      = BS.take (num n) (BS.drop (num src) bs1)
+      b'     = BS.drop (num n) b
+    in
+      ConcreteMemory $
+        a <> BS.replicate (num dst - BS.length a) 0 <> c <> b'
+
+readMemoryWord :: Word -> Memory -> Word
+readMemoryWord (C _ i) (ConcreteMemory m) =
+  let
+    go !a (-1) = a
+    go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m)
+                              (8 * (31 - n))) (n - 1)
+  in {-# SCC readMemoryWord #-}
+    w256 $ go (0 :: W256) (31 :: Int)
+
+readMemoryWord32 :: Word -> Memory -> Word
+readMemoryWord32 (C _ i) (ConcreteMemory m) =
+  let
+    go !a (-1) = a
+    go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m)
+                              (8 * (3 - n))) (n - 1)
+  in {-# SCC readMemoryWord32 #-}
+    w256 $ go (0 :: W256) (3 :: Int)
+
+setMemoryWord :: Word -> Word -> Memory -> Memory
+setMemoryWord (C _ i) (C _ x) m =
+  writeMemory (B (word256Bytes x)) 32 0 (num i) m
+
+setMemoryByte :: Word -> Byte -> Memory -> Memory
+setMemoryByte (C _ i) (ConcreteByte x) m =
+  writeMemory (B (BS.singleton x)) 1 0 (num i) m
+
+readBlobWord :: Word -> Blob -> Word
+readBlobWord (C _ i) (B x) =
+  if i > num (BS.length x)
+  then 0
+  else w256 (wordAt (num i) x)
+
+blobSize :: Blob -> Word
+blobSize (B x) = w256 (num (BS.length x))
+
+keccakBlob :: Blob -> Word
+keccakBlob (B x) = C (FromKeccak x) (keccak x)
+
+deriving instance Bits Byte
+deriving instance FiniteBits Byte
+deriving instance Enum Byte
+deriving instance Eq Byte
+deriving instance Integral Byte
+deriving instance IsString Blob
+deriving instance Monoid Blob
+deriving instance Monoid Memory
+deriving instance Num Byte
+deriving instance Ord Byte
+deriving instance Real Byte
+deriving instance Show Blob
+
+instance Show Word where
+  show (C Dull x) = show x
+  show (C whiff x) = show whiff ++ ": " ++ show x
+
+instance Read Word where
+  readsPrec n s =
+    case readsPrec n s of
+      [(x, r)] -> [(C Dull x, r)]
+      _ -> []
+
+instance Bits Word where
+  (C _ x) .&. (C _ y) = w256 (x .&. y)
+  (C _ x) .|. (C _ y) = w256 (x .|. y)
+  (C _ x) `xor` (C _ y) = w256 (x `xor` y)
+  complement (C _ x) = w256 (complement x)
+  shift (C _ x) i = w256 (shift x i)
+  rotate (C _ x) i = w256 (rotate x i)
+  bitSize (C _ x) = bitSize x
+  bitSizeMaybe (C _ x) = bitSizeMaybe x
+  isSigned (C _ x) = isSigned x
+  testBit (C _ x) i = testBit x i
+  bit i = w256 (bit i)
+  popCount (C _ x) = popCount x
+
+instance FiniteBits Word where
+  finiteBitSize (C _ x) = finiteBitSize x
+  countLeadingZeros (C _ x) = countLeadingZeros x
+  countTrailingZeros (C _ x) = countTrailingZeros x
+
+instance Bounded Word where
+  minBound = w256 minBound
+  maxBound = w256 maxBound
+
+instance Eq Word where
+  (C _ x) == (C _ y) = x == y
+
+instance Enum Word where
+  toEnum i = w256 (toEnum i)
+  fromEnum (C _ x) = fromEnum x
+
+instance Integral Word where
+  quotRem (C _ x) (C _ y) =
+    let (a, b) = quotRem x y
+    in (w256 a, w256 b)
+  toInteger (C _ x) = toInteger x
+
+instance Num Word where
+  (C _ x) + (C _ y) = w256 (x + y)
+  (C _ x) * (C _ y) = w256 (x * y)
+  abs (C _ x) = w256 (abs x)
+  signum (C _ x) = w256 (signum x)
+  fromInteger x = w256 (fromInteger x)
+  negate (C _ x) = w256 (negate x)
+
+instance Real Word where
+  toRational (C _ x) = toRational x
+
+instance Ord Word where
+  compare (C _ x) (C _ y) = compare x y
+
+-- Copied from the standard library just to get specialization.
+-- We also use bit operations instead of modulo and multiply.
+-- (This operation was significantly slow.)
+(^) :: W256 -> W256 -> W256
+x0 ^ y0 | y0 < 0    = errorWithoutStackTrace "Negative exponent"
+        | y0 == 0   = 1
+        | otherwise = f x0 y0
+    where
+          f x y | not (testBit y 0) = f (x * x) (y `shiftR` 1)
+                | y == 1      = x
+                | otherwise   = g (x * x) ((y - 1) `shiftR` 1) x
+          g x y z | not (testBit y 0) = g (x * x) (y `shiftR` 1) z
+                  | y == 1      = x * z
+                  | otherwise   = g (x * x) ((y - 1) `shiftR` 1) (x * z)
diff --git a/src/EVM/Dapp.hs b/src/EVM/Dapp.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Dapp.hs
@@ -0,0 +1,113 @@
+{-# Language TemplateHaskell #-}
+
+module EVM.Dapp where
+
+import EVM (Trace, traceCodehash, traceOpIx)
+import EVM.ABI (Event)
+import EVM.Debug (srcMapCodePos)
+import EVM.Keccak (abiKeccak)
+import EVM.Solidity (SolcContract, CodeType (..), SourceCache, SrcMap)
+import EVM.Solidity (contractName)
+import EVM.Solidity (runtimeCodehash, creationCodehash, abiMap)
+import EVM.Solidity (runtimeSrcmap, creationSrcmap, eventMap)
+import EVM.Solidity (methodSignature, contractAst, astIdMap, astSrcMap)
+import EVM.Types (W256)
+
+import Data.Aeson (Value)
+import Data.Text (Text, isPrefixOf, pack)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Map (Map)
+import Data.Monoid ((<>))
+import Data.Word (Word32)
+import Data.List (sort)
+
+import Control.Arrow ((>>>))
+import Control.Lens
+
+import qualified Data.Map as Map
+
+data DappInfo = DappInfo
+  { _dappRoot       :: FilePath
+  , _dappSolcByName :: Map Text SolcContract
+  , _dappSolcByHash :: Map W256 (CodeType, SolcContract)
+  , _dappSources    :: SourceCache
+  , _dappUnitTests  :: [(Text, [Text])]
+  , _dappEventMap   :: Map W256 Event
+  , _dappAstIdMap   :: Map Int Value
+  , _dappAstSrcMap  :: (SrcMap -> Maybe Value)
+  }
+
+makeLenses ''DappInfo
+
+dappInfo
+  :: FilePath -> Map Text SolcContract -> SourceCache -> DappInfo
+dappInfo root solcByName sources =
+  let
+    solcs = Map.elems solcByName
+    astIds = astIdMap (map (view contractAst) solcs)
+
+  in DappInfo
+    { _dappRoot = root
+    , _dappUnitTests = findUnitTests ("test" `isPrefixOf`) solcs
+    , _dappSources = sources
+    , _dappSolcByName = solcByName
+    , _dappSolcByHash =
+        let
+          f g k = Map.fromList [(view g x, (k, x)) | x <- solcs]
+        in
+          mappend
+           (f runtimeCodehash  Runtime)
+           (f creationCodehash Creation)
+
+    , _dappEventMap =
+        -- Sum up the event ABI maps from all the contracts.
+        mconcat (map (view eventMap) solcs)
+
+    , _dappAstIdMap  = astIds
+    , _dappAstSrcMap = astSrcMap astIds
+    }
+
+unitTestMarkerAbi :: Word32
+unitTestMarkerAbi = abiKeccak (encodeUtf8 "IS_TEST()")
+
+findUnitTests :: (Text -> Bool) -> ([SolcContract] -> [(Text, [Text])])
+findUnitTests matcher =
+  concatMap $ \c ->
+    case preview (abiMap . ix unitTestMarkerAbi) c of
+      Nothing -> []
+      Just _  ->
+        let testNames = (unitTestMethods matcher) c
+        in if null testNames
+           then []
+           else [(view contractName c, testNames)]
+
+unitTestMethods :: (Text -> Bool) -> (SolcContract -> [Text])
+unitTestMethods matcher =
+  view abiMap
+    >>> Map.elems
+    >>> map (view methodSignature)
+    >>> filter matcher
+    >>> sort
+
+traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap
+traceSrcMap dapp trace =
+  let
+    h = view traceCodehash trace
+    i = view traceOpIx trace
+  in case preview (dappSolcByHash . ix h) dapp of
+    Nothing ->
+      Nothing
+    Just (Creation, solc) ->
+      preview (creationSrcmap . ix i) solc
+    Just (Runtime, solc) ->
+      preview (runtimeSrcmap . ix i) solc
+
+showTraceLocation :: DappInfo -> Trace -> Either Text Text
+showTraceLocation dapp trace =
+  case traceSrcMap dapp trace of
+    Nothing -> Left "<no source map>"
+    Just sm ->
+      case srcMapCodePos (view dappSources dapp) sm of
+        Nothing -> Left "<source not found>"
+        Just (fileName, lineIx) ->
+          Right (fileName <> ":" <> pack (show lineIx))
diff --git a/src/EVM/Debug.hs b/src/EVM/Debug.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Debug.hs
@@ -0,0 +1,145 @@
+module EVM.Debug where
+
+import EVM          (Contract, storage, nonce, balance)
+import EVM          (bytecode, codehash, bytecode)
+import EVM.Solidity (SrcMap, srcMapFile, srcMapOffset, srcMapLength)
+import EVM.Solidity (SourceCache, sourceFiles)
+import EVM.Types    (Addr)
+
+import Control.Arrow   (second)
+import Control.Lens
+import Data.ByteString (ByteString)
+import Data.Map        (Map)
+import Data.Text       (Text)
+
+import qualified Data.ByteString       as ByteString
+import qualified Data.Map              as Map
+
+import Text.PrettyPrint.ANSI.Leijen
+
+data Mode = Debug | Run deriving (Eq, Show)
+
+object :: [(Doc, Doc)] -> Doc
+object xs =
+  group $ lbrace
+    <> line
+    <> indent 2 (sep (punctuate (char ';') [k <+> equals <+> v | (k, v) <- xs]))
+    <> line
+    <> rbrace
+
+prettyContract :: Contract -> Doc
+prettyContract c =
+  object $
+    [ (text "codesize", int (ByteString.length (c ^. bytecode)))
+    , (text "codehash", text (show (c ^. codehash)))
+    , (text "balance", int (fromIntegral (c ^. balance)))
+    , (text "nonce", int (fromIntegral (c ^. nonce)))
+    , (text "code", text (show (ByteString.take 16 (c ^. bytecode))))
+    , (text "storage", text (show (c ^. storage)))
+    ]
+
+prettyContracts :: Map Addr Contract -> Doc
+prettyContracts x =
+  object $
+    (map (\(a, b) -> (text (show a), prettyContract b))
+     (Map.toList x))
+
+-- debugger :: Maybe SourceCache -> VM -> IO VM
+-- debugger maybeCache vm = do
+--   -- cpprint (view state vm)
+--   cpprint ("pc" :: Text, view (state . pc) vm)
+--   cpprint (view (state . stack) vm)
+--   -- cpprint (view logs vm)
+--   cpprint (vmOp vm)
+--   cpprint (opParams vm)
+--   cpprint (length (view frames vm))
+
+--   -- putDoc (prettyContracts (view (env . contracts) vm))
+
+--   case maybeCache of
+--     Nothing ->
+--       return ()
+--     Just cache ->
+--       case currentSrcMap vm of
+--         Nothing -> cpprint ("no srcmap" :: Text)
+--         Just sm -> cpprint (srcMapCode cache sm)
+
+--   if vm ^. result /= Nothing
+--     then do
+--       print (vm ^. result)
+--       return vm
+--     else
+--     -- readline "(evm) " >>=
+--     return (Just "") >>=
+--       \case
+--         Nothing ->
+--           return vm
+--         Just cmdline ->
+--           case words cmdline of
+--             [] ->
+--               debugger maybeCache (execState exec1 vm)
+
+--             ["block"] ->
+--               do cpprint (view block vm)
+--                  debugger maybeCache vm
+
+--             ["storage"] ->
+--               do cpprint (view (env . contracts) vm)
+--                  debugger maybeCache vm
+
+--             ["contracts"] ->
+--               do putDoc (prettyContracts (view (env . contracts) vm))
+--                  debugger maybeCache vm
+
+--             -- ["disassemble"] ->
+--             --   do cpprint (mkCodeOps (view (state . code) vm))
+--             --      debugger maybeCache vm
+
+--             _  -> debugger maybeCache vm
+
+-- lookupSolc :: VM -> W256 -> Maybe SolcContract
+-- lookupSolc vm hash =
+--   case vm ^? env . solcByRuntimeHash . ix hash of
+--     Just x -> Just x
+--     Nothing ->
+--       vm ^? env . solcByCreationHash . ix hash
+
+-- currentSolc :: VM -> Maybe SolcContract
+-- currentSolc vm =
+--   let
+--     c = vm ^?! env . contracts . ix (vm ^. state . contract)
+--     theCodehash = view codehash c
+--   in
+--     case vm ^? env . solcByRuntimeHash . ix theCodehash of
+--         Just x ->
+--           Just x
+--         Nothing ->
+--           vm ^? env . solcByCreationHash . ix theCodehash
+
+-- currentSrcMap :: VM -> Maybe SrcMap
+-- currentSrcMap vm =
+--   let
+--     c = vm ^?! env . contracts . ix (vm ^. state . contract)
+--     theOpIx = (c ^. opIxMap) Vector.! (vm ^. state . pc)
+--     theCodehash = view codehash c
+--     (isRuntime, solc) =
+--       case vm ^? env . solcByRuntimeHash . ix theCodehash of
+--         Just x ->
+--           (True, Just x)
+--         Nothing ->
+--           (False, vm ^? env . solcByCreationHash . ix theCodehash)
+--     srcmapLens = if isRuntime then runtimeSrcmap else creationSrcmap
+--   in
+--     join (fmap (preview (srcmapLens . ix theOpIx)) solc)
+
+srcMapCodePos :: SourceCache -> SrcMap -> Maybe (Text, Int)
+srcMapCodePos cache sm =
+  fmap (second f) $ cache ^? sourceFiles . ix (srcMapFile sm)
+  where
+    f v = ByteString.count 0xa (ByteString.take (srcMapOffset sm - 1) v) + 1
+
+srcMapCode :: SourceCache -> SrcMap -> Maybe ByteString
+srcMapCode cache sm =
+  fmap f $ cache ^? sourceFiles . ix (srcMapFile sm)
+  where
+    f (_, v) = ByteString.take (min 80 (srcMapLength sm)) (ByteString.drop (srcMapOffset sm) v)
diff --git a/src/EVM/Dev.hs b/src/EVM/Dev.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Dev.hs
@@ -0,0 +1,82 @@
+module EVM.Dev where
+
+import System.Directory
+
+import EVM.Dapp
+import EVM.Solidity
+import EVM.UnitTest
+
+import qualified EVM.Fetch
+import qualified EVM.TTY
+import qualified EVM.Emacs
+import qualified EVM.Facts     as Facts
+import qualified EVM.Facts.Git as Git
+
+import Data.Text (isPrefixOf)
+
+import qualified Data.Map as Map
+
+loadDappInfo :: String -> String -> IO DappInfo
+loadDappInfo path file =
+  withCurrentDirectory path $
+    readSolc file >>=
+      \case
+        Just (contractMap, cache) -> do
+          pure (dappInfo "." contractMap cache)
+        _ ->
+          error "nope, sorry"
+
+ghciTest :: String -> String -> Maybe String -> IO [Bool]
+ghciTest root path state =
+  withCurrentDirectory root $ do
+    loadFacts <-
+      case state of
+        Nothing ->
+          pure id
+        Just repoPath -> do
+          facts <- Git.loadFacts (Git.RepoAt repoPath)
+          pure (flip Facts.apply facts)
+    params <- getParametersFromEnvironmentVariables
+    let
+      opts = UnitTestOptions
+        { oracle = EVM.Fetch.zero
+        , verbose = False
+        , match = ""
+        , vmModifier = loadFacts
+        , testParams = params
+        }
+    readSolc path >>=
+      \case
+        Just (contractMap, cache) -> do
+          let unitTests = findUnitTests ("test" `isPrefixOf`) (Map.elems contractMap)
+          mapM (runUnitTestContract opts contractMap cache) unitTests
+        Nothing ->
+          error ("Failed to read Solidity JSON for `" ++ path ++ "'")
+
+ghciTty :: String -> String -> Maybe String -> IO ()
+ghciTty root path state =
+  withCurrentDirectory root $ do
+    loadFacts <-
+      case state of
+        Nothing ->
+          pure id
+        Just repoPath -> do
+          facts <- Git.loadFacts (Git.RepoAt repoPath)
+          pure (flip Facts.apply facts)
+    params <- getParametersFromEnvironmentVariables
+    let
+      testOpts = UnitTestOptions
+        { oracle = EVM.Fetch.zero
+        , verbose = False
+        , match = ""
+        , vmModifier = loadFacts
+        , testParams = params
+        }
+    EVM.TTY.main testOpts root path
+
+ghciEmacs :: IO ()
+ghciEmacs =
+  EVM.Emacs.main
+
+foo :: IO ()
+foo = ghciEmacs
diff --git a/src/EVM/Emacs.hs b/src/EVM/Emacs.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Emacs.hs
@@ -0,0 +1,485 @@
+{-# Language ImplicitParams #-}
+{-# Language TemplateHaskell #-}
+{-# Language FlexibleInstances #-}
+
+module EVM.Emacs where
+
+import Control.Lens
+import Control.Monad.IO.Class
+import Control.Monad.State.Strict hiding (state)
+import Data.ByteString (ByteString)
+import Data.Map (Map)
+import Data.Maybe
+import Data.Monoid
+import Data.SCargot
+import Data.SCargot.Language.HaskLike
+import Data.SCargot.Repr
+import Data.SCargot.Repr.Basic
+import Data.Text (Text, pack, unpack)
+import EVM
+import EVM.Concrete
+import EVM.Dapp
+import EVM.Fetch (Fetcher)
+import EVM.Solidity
+import EVM.Stepper (Stepper)
+import EVM.TTY (currentSrcMap)
+import EVM.Types
+import EVM.UnitTest hiding (interpret)
+import Prelude hiding (Word)
+import System.Directory
+import System.IO
+import qualified Control.Monad.Operational as Operational
+import qualified Data.ByteString as BS
+import qualified Data.Map as Map
+import qualified EVM.Fetch as Fetch
+import qualified EVM.Stepper as Stepper
+
+data UiVmState = UiVmState
+  { _uiVm             :: VM
+  , _uiVmNextStep     :: Stepper ()
+  , _uiVmSolc         :: Maybe SolcContract
+  , _uiVmDapp         :: Maybe DappInfo
+  , _uiVmStepCount    :: Int
+  , _uiVmFirstState   :: UiVmState
+  , _uiVmFetcher      :: Fetcher
+  , _uiVmMessage      :: Maybe Text
+  }
+
+makeLenses ''UiVmState
+
+type Pred a = a -> Bool
+
+data StepMode
+  = StepOne                        -- ^ Finish after one opcode step
+  | StepMany !Int                  -- ^ Run a specific number of steps
+  | StepNone                       -- ^ Finish before the next opcode
+  | StepUntil (Pred VM)            -- ^ Finish when a VM predicate holds
+
+data StepOutcome a
+  = Returned a                -- ^ Program finished
+  | Stepped  (Stepper a)      -- ^ Took one step; more steps to go
+  | Blocked  (IO (Stepper a)) -- ^ Came across blocking request
+
+interpret
+  :: StepMode
+  -> Stepper a
+  -> State UiVmState (StepOutcome a)
+interpret mode =
+  eval . Operational.view
+  where
+    eval
+      :: Operational.ProgramView Stepper.Action a
+      -> State UiVmState (StepOutcome a)
+
+    eval (Operational.Return x) =
+      pure (Returned x)
+
+    eval (action Operational.:>>= k) =
+      case action of
+
+        -- Stepper wants to keep executing?
+        Stepper.Exec -> do
+
+          let
+            -- When pausing during exec, we should later restart
+            -- the exec with the same continuation.
+            restart = Stepper.exec >>= k
+
+          case mode of
+            StepNone ->
+              -- We come here when we've continued while stepping,
+              -- either from a query or from a return;
+              -- we should pause here and wait for the user.
+              pure (Stepped (Operational.singleton action >>= k))
+
+            StepOne -> do
+              -- Run an instruction
+              modify stepOneOpcode
+
+              use (uiVm . result) >>= \case
+                Nothing ->
+                  -- If instructions remain, then pause & await user.
+                  pure (Stepped restart)
+                Just r ->
+                  -- If returning, proceed directly the continuation,
+                  -- but stopping before the next instruction.
+                  interpret StepNone (k r)
+
+            StepMany 0 -> do
+              -- Finish the continuation until the next instruction;
+              -- then, pause & await user.
+              interpret StepNone restart
+
+            StepMany i -> do
+              -- Run one instruction.
+              interpret StepOne restart >>=
+                \case
+                  Stepped stepper ->
+                    interpret (StepMany (i - 1)) stepper
+
+                  -- This shouldn't happen, because re-stepping needs
+                  -- to avoid blocking and halting.
+                  r -> pure r
+
+            StepUntil p -> do
+              vm <- use uiVm
+              case p vm of
+                True ->
+                  interpret StepNone restart
+                False ->
+                  interpret StepOne restart >>=
+                    \case
+                      Stepped stepper ->
+                        interpret (StepUntil p) stepper
+
+                      -- This means that if we hit a blocking query
+                      -- or a return, we pause despite the predicate.
+                      --
+                      -- This could be fixed if we allowed query I/O
+                      -- here, instead of only in the TTY event loop;
+                      -- let's do it later.
+                      r -> pure r
+
+        -- Stepper wants to make a query and wait for the results?
+        Stepper.Wait q -> do
+          fetcher <- use uiVmFetcher
+          -- Tell the TTY to run an I/O action to produce the next stepper.
+          pure . Blocked $ do
+            -- First run the fetcher, getting a VM state transition back.
+            m <- fetcher q
+            -- Join that transition with the stepper script's continuation.
+            pure (Stepper.evm m >> k ())
+
+        -- Stepper wants to modify the VM.
+        Stepper.EVM m -> do
+          vm0 <- use uiVm
+          let (r, vm1) = runState m vm0
+          modify (flip updateUiVmState vm1)
+          interpret mode (k r)
+
+        -- Stepper wants to emit a message.
+        Stepper.Note s -> do
+          assign uiVmMessage (Just s)
+          interpret mode (k ())
+
+        -- Stepper wants to exit because of a failure.
+        Stepper.Fail e ->
+          error ("VM error: " ++ show e)
+
+stepOneOpcode :: UiVmState -> UiVmState
+stepOneOpcode ui =
+  let
+    nextVm = execState exec1 (view uiVm ui)
+  in
+    ui & over uiVmStepCount (+ 1)
+       & set uiVm nextVm
+
+updateUiVmState :: UiVmState -> VM -> UiVmState
+updateUiVmState ui vm =
+  ui & set uiVm vm
+
+type Sexp = WellFormedSExpr HaskLikeAtom
+
+prompt :: Console (Maybe Sexp)
+prompt = do
+  line <- liftIO (putStr "> " >> hFlush stdout >> getLine)
+  case decodeOne (asWellFormed haskLikeParser) (pack line) of
+    Left e -> do
+      output (L [A "error", A (txt e)])
+      pure Nothing
+    Right s ->
+      pure (Just s)
+
+class SDisplay a where
+  sexp :: a -> SExpr Text
+
+display :: SDisplay a => a -> Text
+display = encodeOne (basicPrint id) . sexp
+
+txt :: Show a => a -> Text
+txt = pack . show
+
+data UiState
+  = UiStarted
+  | UiDappLoaded DappInfo
+  | UiVm UiVmState
+
+type Console a = StateT UiState IO a
+
+output :: SDisplay a => a -> Console ()
+output = liftIO . putStrLn . unpack . display
+
+main :: IO ()
+main = do
+  putStrLn ";; Welcome to Hevm's Emacs integration."
+  _ <- execStateT loop UiStarted
+  pure ()
+
+loop :: Console ()
+loop =
+  prompt >>=
+    \case
+      Nothing -> pure ()
+      Just command -> do
+        handle command
+        loop
+
+handle :: Sexp -> Console ()
+handle (WFSList (WFSAtom (HSIdent cmd) : args)) =
+  do s <- get
+     handleCmd s (cmd, args)
+handle _ =
+  output (L [A ("unrecognized-command" :: Text)])
+
+handleCmd :: UiState -> (Text, [Sexp]) -> Console ()
+handleCmd UiStarted = \case
+  ("load-dapp",
+   [WFSAtom (HSString (unpack -> root)),
+    WFSAtom (HSString (unpack -> jsonPath))]) ->
+    do liftIO (setCurrentDirectory root)
+       liftIO (readSolc jsonPath) >>=
+         \case
+           Nothing ->
+             output (L [A ("error" :: Text)])
+           Just (contractMap, sourceCache) ->
+             let
+               dapp = dappInfo root contractMap sourceCache
+             in do
+               output dapp
+               put (UiDappLoaded dapp)
+
+  _ ->
+    output (L [A ("unrecognized-command" :: Text)])
+
+handleCmd (UiDappLoaded dapp) = \case
+  ("run-test", [WFSAtom (HSString contractPath),
+                WFSAtom (HSString testName)]) -> do
+    opts <- defaultUnitTestOptions
+    put (UiVm (initialStateForTest opts dapp (contractPath, testName)))
+    outputVm
+  _ ->
+    output (L [A ("unrecognized-command" :: Text)])
+
+handleCmd (UiVm s) = \case
+  ("step", [WFSAtom (HSString modeName)]) -> do
+    case parseStepMode s modeName of
+      Just mode -> do
+        takeStep s StepNormally mode
+        outputVm
+      Nothing ->
+        output (L [A ("unrecognized-command" :: Text)])
+  _ ->
+    output (L [A ("unrecognized-command" :: Text)])
+
+outputVm :: Console ()
+outputVm = do
+  UiVm s <- get
+  let
+    noMap =
+      output $
+        L [ A "step"
+          , L [A ("pc" :: Text), A (txt (view (uiVm . state . pc) s))]]
+
+  fromMaybe noMap $ do
+    dapp <- view uiVmDapp s
+    sm <- currentSrcMap dapp (view uiVm s)
+    (fileName, _) <- view (dappSources . sourceFiles . at (srcMapFile sm)) dapp
+    pure . output $
+      L [ A "step"
+        , L [A ("vm" :: Text), sexp (view uiVm s)]
+        , L [A ("file" :: Text), A (txt fileName)]
+        , L [ A ("srcmap" :: Text)
+            , A (txt (srcMapOffset sm))
+            , A (txt (srcMapLength sm))
+            , A (txt (srcMapJump sm))
+            ]
+        ]
+
+
+isNextSourcePosition
+  :: UiVmState -> Pred VM
+isNextSourcePosition ui vm =
+  let
+    Just dapp       = view uiVmDapp ui
+    initialPosition = currentSrcMap dapp (view uiVm ui)
+  in
+    currentSrcMap dapp vm /= initialPosition
+
+parseStepMode :: UiVmState -> Text -> Maybe StepMode
+parseStepMode s =
+  \case
+    "once" -> Just StepOne
+    "source-location" -> Just (StepUntil (isNextSourcePosition s))
+    _ -> Nothing
+
+-- ^ Specifies whether to do I/O blocking or VM halting while stepping.
+-- When we step backwards, we don't want to allow those things.
+data StepPolicy
+  = StepNormally    -- ^ Allow blocking and returning
+  | StepTimidly     -- ^ Forbid blocking and returning
+
+takeStep
+  :: UiVmState
+  -> StepPolicy
+  -> StepMode
+  -> Console ()
+takeStep ui policy mode = do
+  let m = interpret mode (view uiVmNextStep ui)
+
+  case runState m ui of
+
+    (Stepped stepper, ui') -> do
+      put (UiVm (ui' & set uiVmNextStep stepper))
+
+    (Blocked blocker, ui') ->
+      case policy of
+        StepNormally -> do
+          stepper <- liftIO blocker
+          takeStep
+            (execState (assign uiVmNextStep stepper) ui')
+            StepNormally StepNone
+
+        StepTimidly ->
+          error "step blocked unexpectedly"
+
+    (Returned (), ui') ->
+      case policy of
+        StepNormally ->
+          put (UiVm ui')
+        StepTimidly ->
+          error "step halted unexpectedly"
+
+  -- readSolc jsonPath >>=
+  --   \case
+  --     Nothing -> error "Failed to read Solidity JSON"
+  --     Just (contractMap, sourceCache) -> do
+  --       let
+  --         dapp = dappInfo root contractMap sourceCache
+  --       putStrLn (unpack (display dapp))
+
+instance SDisplay DappInfo where
+  sexp x =
+    L [ A "dapp-info"
+      , L [A "root", A (txt $ view dappRoot x)]
+      , L (A "unit-tests" :
+            [ L [A (txt a), L (map (A . txt) b)]
+            | (a, b) <- view dappUnitTests x])
+      ]
+
+instance SDisplay (SExpr Text) where
+  sexp = id
+
+instance SDisplay VM where
+  sexp x =
+    L [ L [A "result", sexp (view result x)]
+      , L [A "state", sexp (view state x)]
+      , L [A "frames", sexp (view frames x)]
+      , L [A "contracts", sexp (view (env . contracts) x)]
+      ]
+
+quoted :: Text -> Text
+quoted x = "\"" <> x <> "\""
+
+instance SDisplay Addr where
+  sexp = A . quoted . pack . showAddrWith0x
+
+instance SDisplay Contract where
+  sexp x =
+    L [ L [A "storage", sexp (view storage x)]
+      , L [A "balance", sexp (view balance x)]
+      , L [A "nonce", sexp (view nonce x)]
+      , L [A "codehash", sexp (view codehash x)]
+      ]
+
+instance SDisplay W256 where
+  sexp x = A (txt (txt x))
+
+instance (SDisplay k, SDisplay v) => SDisplay (Map k v) where
+  sexp x = L [L [sexp k, sexp v] | (k, v) <- Map.toList x]
+
+instance SDisplay a => SDisplay (Maybe a) where
+  sexp Nothing = A "nil"
+  sexp (Just x) = sexp x
+
+instance SDisplay VMResult where
+  sexp = \case
+    VMFailure e -> L [A "vm-failure", A (txt (txt e))]
+    VMSuccess b -> L [A "vm-success", sexp b]
+
+instance SDisplay Frame where
+  sexp x =
+    L [A "frame", sexp (view frameContext x), sexp (view frameState x)]
+
+instance SDisplay Blob where
+  sexp (B x) = sexp x
+
+instance SDisplay FrameContext where
+  sexp _x = A "some-context"
+
+instance SDisplay FrameState where
+  sexp x =
+    L [ L [A "contract", sexp (view contract x)]
+      , L [A "code-contract", sexp (view codeContract x)]
+      , L [A "pc", A (txt (view pc x))]
+      , L [A "stack", sexp (view stack x)]
+      , L [A "memory", sexp (view memory x)]
+      ]
+
+instance SDisplay a => SDisplay [a] where
+  sexp = L . map sexp
+
+instance SDisplay Word where
+  sexp (C Dull x) = A (quoted (txt x))
+  sexp (C (FromKeccak bs) x) =
+    L [A "hash", A (txt x), sexp bs]
+
+instance SDisplay ByteString where
+  sexp = A . txt . pack . showByteStringWith0x
+
+instance SDisplay Memory where
+  sexp (ConcreteMemory bs) =
+    if BS.length bs > 1024
+    then L [A "large-memory", A (txt (BS.length bs))]
+    else sexp bs
+
+defaultUnitTestOptions :: MonadIO m => m UnitTestOptions
+defaultUnitTestOptions = do
+  params <- liftIO getParametersFromEnvironmentVariables
+  pure UnitTestOptions
+    { oracle            = Fetch.zero
+    , verbose           = False
+    , match             = ""
+    , vmModifier        = id
+    , testParams        = params
+    }
+
+initialStateForTest
+  :: UnitTestOptions
+  -> DappInfo
+  -> (Text, Text)
+  -> UiVmState
+initialStateForTest opts@(UnitTestOptions {..}) dapp (contractPath, testName) =
+  ui1
+  where
+    script = do
+      Stepper.evm . pushTrace . EntryTrace $
+        "test " <> testName <> " (" <> contractPath <> ")"
+      initializeUnitTest opts
+      void (runUnitTest opts testName)
+    ui0 =
+      UiVmState
+        { _uiVm             = vm0
+        , _uiVmNextStep     = script
+        , _uiVmSolc         = Just testContract
+        , _uiVmDapp         = Just dapp
+        , _uiVmStepCount    = 0
+        , _uiVmFirstState   = undefined
+        , _uiVmFetcher      = oracle
+        , _uiVmMessage      = Nothing
+        }
+    Just testContract =
+      view (dappSolcByName . at contractPath) dapp
+    vm0 =
+      initialUnitTestVm opts testContract (Map.elems (view dappSolcByName dapp))
+    ui1 =
+      updateUiVmState ui0 vm0 & set uiVmFirstState ui1
diff --git a/src/EVM/Exec.hs b/src/EVM/Exec.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Exec.hs
@@ -0,0 +1,76 @@
+module EVM.Exec where
+
+import EVM
+import EVM.Keccak (newContractAddress)
+import EVM.Types
+
+import qualified EVM.FeeSchedule as FeeSchedule
+
+import Control.Lens
+import Control.Monad.State.Class (MonadState)
+import Control.Monad.State.Strict (runState)
+import Data.ByteString (ByteString)
+import Data.Maybe (isNothing)
+
+import qualified Control.Monad.State.Class as State
+
+ethrunAddress :: Addr
+ethrunAddress = Addr 0x00a329c0648769a73afac7f9381e08fb43dbea72
+
+vmForEthrunCreation :: ByteString -> VM
+vmForEthrunCreation creationCode =
+  (makeVm $ VMOpts
+    { vmoptCode = creationCode
+    , vmoptCalldata = ""
+    , vmoptValue = 0
+    , vmoptAddress = newContractAddress ethrunAddress 1
+    , vmoptCaller = ethrunAddress
+    , vmoptOrigin = ethrunAddress
+    , vmoptCoinbase = 0
+    , vmoptNumber = 0
+    , vmoptTimestamp = 0
+    , vmoptGaslimit = 0
+    , vmoptGasprice = 0
+    , vmoptDifficulty = 0
+    , vmoptGas = 0xffffffffffffffff
+    , vmoptSchedule = FeeSchedule.metropolis
+    }) & set (env . contracts . at ethrunAddress)
+             (Just (initialContract mempty))
+
+exec :: MonadState VM m => m VMResult
+exec =
+  use EVM.result >>= \case
+    Nothing -> State.state (runState exec1) >> exec
+    Just x  -> return x
+
+execWhile :: MonadState VM m => (VM -> Bool) -> m Int
+execWhile p = go 0
+  where
+    go i = do
+      x <- State.get
+      if p x && isNothing (view result x)
+        then do
+          State.state (runState exec1)
+          go $! (i + 1)
+      else
+        return i
+
+-- locateBreakpoint :: UIState -> Text -> Int -> Maybe [(Word256, Vector Bool)]
+-- locateBreakpoint ui fileName lineNo = do
+--   (i, (t, s)) <-
+--     flip find (Map.toList (ui ^. uiSourceCache . sourceFiles))
+--       (\(_, (t, _)) -> t == fileName)
+--   let ls = BS.split 0x0a s
+--       l = ls !! (lineNo - 1)
+--       offset = 1 + sum (map ((+ 1) . BS.length) (take (lineNo - 1) ls))
+--       horizon = offset + BS.length l
+--   return $ Map.elems (ui ^. uiVm . _Just . env . solc)
+--     & map (\c -> (
+--         c ^. solcCodehash,
+--         Vector.create $ new (Seq.length (c ^. solcSrcmap)) >>= \v -> do
+--           fst $ foldl' (\(!m, !j) (sm@SM { srcMapOffset = o }) ->
+--             if srcMapFile sm == i && o >= offset && o < horizon
+--             then (m >> write v j True, j + 1)
+--             else (m >> write v j False, j + 1)) (return (), 0) (c ^. solcSrcmap)
+--           return v
+--       ))
diff --git a/src/EVM/Facts.hs b/src/EVM/Facts.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Facts.hs
@@ -0,0 +1,197 @@
+{-# Language PartialTypeSignatures #-}
+{-# Language FlexibleInstances #-}
+{-# Language ExtendedDefaultRules #-}
+{-# Language NamedFieldPuns #-}
+{-# Language PatternSynonyms #-}
+{-# Language RecordWildCards #-}
+{-# Language ScopedTypeVariables #-}
+{-# Language ViewPatterns #-}
+
+-- Converts between Ethereum contract states and simple trees of
+-- texts.  Dumps and loads such trees as Git repositories (the state
+-- gets serialized as commits with folders and files).
+--
+-- Example state file hierarchy:
+--
+--   /0123...abc/balance      says "0x500"
+--   /0123...abc/code         says "60023429..."
+--   /0123...abc/nonce        says "0x3"
+--   /0123...abc/storage/0x1  says "0x1"
+--   /0123...abc/storage/0x2  says "0x0"
+--
+-- This format could easily be serialized into any nested record
+-- syntax, e.g. JSON.
+
+module EVM.Facts
+  ( File (..)
+  , Fact (..)
+  , Data (..)
+  , Path (..)
+  , apply
+  , contractFacts
+  , vmFacts
+  , factToFile
+  , fileToFact
+  ) where
+
+import EVM          (VM, Contract)
+import EVM.Concrete (Word)
+import EVM          (balance, nonce, storage, bytecode, env, contracts)
+import EVM.Types    (Addr)
+
+import qualified EVM as EVM
+
+import Prelude hiding (Word)
+
+import Control.Lens    (view, set, at, ix, (&))
+import Data.ByteString (ByteString)
+import Data.Monoid     ((<>))
+import Data.Ord        (comparing)
+import Data.Set        (Set)
+import Text.Read       (readMaybe)
+
+import qualified Data.ByteString.Base16 as BS16
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+-- We treat everything as ASCII byte strings because
+-- we only use hex digits (and the letter 'x').
+type ASCII = ByteString
+
+-- When using string literals, default to infer the ASCII type.
+default (ASCII)
+
+-- We use the word "fact" to mean one piece of serializable
+-- information about the state.
+--
+-- Note that Haskell allows this kind of union of records.
+-- It's convenient here, but typically avoided.
+data Fact
+  = BalanceFact { addr :: Addr, what :: Word }
+  | NonceFact   { addr :: Addr, what :: Word }
+  | StorageFact { addr :: Addr, what :: Word, which :: Word }
+  | CodeFact    { addr :: Addr, blob :: ByteString }
+  deriving (Eq, Show)
+
+-- A fact path means something like "/0123...abc/storage/0x1",
+-- or alternatively "contracts['0123...abc'].storage['0x1']".
+data Path = Path [ASCII] ASCII
+  deriving (Eq, Ord, Show)
+
+-- A fact data is the content of a file.  We encapsulate it
+-- with a newtype to make it easier to change the representation
+-- (to use bytestrings, some sum type, or whatever).
+newtype Data = Data { dataASCII :: ASCII }
+  deriving (Eq, Ord, Show)
+
+-- We use the word "file" to denote a serialized value at a path.
+data File = File { filePath :: Path, fileData :: Data }
+  deriving (Eq, Ord, Show)
+
+class AsASCII a where
+  dump :: a -> ASCII
+  load :: ASCII -> Maybe a
+
+instance AsASCII Addr where
+  dump = Char8.pack . show
+  load = readMaybe . Char8.unpack
+
+instance AsASCII Word where
+  dump = Char8.pack . show
+  load = readMaybe . Char8.unpack
+
+instance AsASCII ByteString where
+  dump x = BS16.encode x <> "\n"
+  load x =
+    case BS16.decode . mconcat . BS.split 10 $ x of
+      (y, "") -> Just y
+      _       -> Nothing
+
+contractFacts :: Addr -> Contract -> [Fact]
+contractFacts a x = storageFacts a x ++
+  [ BalanceFact a (view balance x)
+  , NonceFact   a (view nonce x)
+  , CodeFact    a (view bytecode x)
+  ]
+
+storageFacts :: Addr -> Contract -> [Fact]
+storageFacts a x = map f (Map.toList (view storage x))
+  where
+    f :: (Word, Word) -> Fact
+    f (k, v) = StorageFact
+      { addr  = a
+      , what  = fromIntegral v
+      , which = fromIntegral k
+      }
+
+vmFacts :: VM -> Set Fact
+vmFacts vm = Set.fromList $ do
+  (k, v) <- Map.toList (view (env . contracts) vm)
+  contractFacts k v
+
+-- Somewhat stupidly, this function demands that for each contract,
+-- the code fact for that contract comes before the other facts for
+-- that contract.  This is an incidental thing because right now we
+-- always initialize contracts starting with the code (to calculate
+-- the code hash and so on).
+--
+-- Therefore, we need to make sure to sort the fact set in such a way.
+apply1 :: VM -> Fact -> VM
+apply1 vm fact =
+  case fact of
+    CodeFact    {..} ->
+      vm & set (env . contracts . at addr) (Just (EVM.initialContract blob))
+    StorageFact {..} ->
+      vm & set (env . contracts . ix addr . storage . at which) (Just what)
+    BalanceFact {..} ->
+      vm & set (env . contracts . ix addr . balance) what
+    NonceFact   {..} ->
+      vm & set (env . contracts . ix addr . nonce) what
+
+-- Sort facts in the right order for `apply1` to work.
+instance Ord Fact where
+  compare = comparing f
+    where
+    f :: Fact -> (Int, Addr, Word)
+    f (CodeFact a _)      = (0, a, 0)
+    f (BalanceFact a _)   = (1, a, 0)
+    f (NonceFact a _)     = (2, a, 0)
+    f (StorageFact a _ x) = (3, a, x)
+
+-- Applies a set of facts to a VM.
+apply :: VM -> Set Fact -> VM
+apply vm =
+  -- The set's ordering is relevant; see `apply1`.
+  foldl apply1 vm
+
+factToFile :: Fact -> File
+factToFile fact = case fact of
+  StorageFact {..} -> mk ["storage"] (dump which) what
+  BalanceFact {..} -> mk []          "balance"    what
+  NonceFact   {..} -> mk []          "nonce"      what
+  CodeFact    {..} -> mk []          "code"       blob
+  where
+    mk :: AsASCII a => [ASCII] -> ASCII -> a -> File
+    mk prefix base a =
+      File (Path (dump (addr fact) : prefix) base)
+           (Data $ dump a)
+
+-- This lets us easier pattern match on serialized things.
+-- Uses language extensions: `PatternSynonyms` and `ViewPatterns`.
+pattern Load :: AsASCII a => a -> ASCII
+pattern Load x <- (load -> Just x)
+
+fileToFact :: File -> Maybe Fact
+fileToFact = \case
+  File (Path [Load a] "code")    (Data (Load x))
+    -> Just (CodeFact a x)
+  File (Path [Load a] "balance") (Data (Load x))
+    -> Just (BalanceFact a x)
+  File (Path [Load a] "nonce")   (Data (Load x))
+    -> Just (NonceFact a x)
+  File (Path [Load a, "storage"] (Load x)) (Data (Load y))
+    -> Just (StorageFact a y x)
+  _
+    -> Nothing
diff --git a/src/EVM/Facts/Git.hs b/src/EVM/Facts/Git.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Facts/Git.hs
@@ -0,0 +1,51 @@
+{-# Language ViewPatterns #-}
+
+-- This is a backend for the fact representation that uses a Git
+-- repository as the store.
+
+module EVM.Facts.Git
+  ( saveFacts
+  , loadFacts
+  , RepoAt (..)
+  ) where
+
+import EVM.Facts (Fact (..), File (..), Path (..), Data (..))
+import EVM.Facts (fileToFact, factToFile)
+
+import Control.Lens
+import Data.Set   (Set)
+import Data.Maybe (catMaybes)
+
+import qualified Data.Set         as Set
+import qualified Restless.Git     as Git
+
+newtype RepoAt = RepoAt String
+  deriving (Eq, Ord, Show)
+
+-- For modularity reasons, we have our own file data type that is
+-- isomorphic with the one in the `restless-git` library.  We declare
+-- the isomorphism so we can go between them easily.
+fileRepr :: Iso' File Git.File
+fileRepr = iso f g
+  where
+    f :: File -> Git.File
+    f (File     (Path ps p)     (Data x)) =
+      (Git.File (Git.Path ps p) x)
+
+    g :: Git.File -> File
+    g (Git.File (Git.Path ps p) x) =
+      (File     (Path ps p)     (Data x))
+
+saveFacts :: RepoAt -> Set Fact -> IO ()
+saveFacts (RepoAt repo) facts =
+  Git.save repo "hevm execution"
+    (Set.map (view fileRepr . factToFile) facts)
+
+prune :: Ord a => Set (Maybe a) -> Set a
+prune = Set.fromList . catMaybes . Set.toList
+
+loadFacts :: RepoAt -> IO (Set Fact)
+loadFacts (RepoAt src) =
+  fmap
+    (prune . Set.map (fileToFact . view (from fileRepr)))
+    (Git.load src)
diff --git a/src/EVM/FeeSchedule.hs b/src/EVM/FeeSchedule.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/FeeSchedule.hs
@@ -0,0 +1,103 @@
+module EVM.FeeSchedule where
+
+data Num n => FeeSchedule n = FeeSchedule
+  { g_zero :: n
+  , g_base :: n
+  , g_verylow :: n
+  , g_low :: n
+  , g_mid :: n
+  , g_high :: n
+  , g_extcode :: n
+  , g_balance :: n
+  , g_sload :: n
+  , g_jumpdest :: n
+  , g_sset :: n
+  , g_sreset :: n
+  , r_sclear :: n
+  , r_selfdestruct :: n
+  , r_selfdestruct_newaccount :: n
+  , g_create :: n
+  , g_codedeposit :: n
+  , g_call :: n
+  , g_callvalue :: n
+  , g_callstipend :: n
+  , g_newaccount :: n
+  , g_exp :: n
+  , g_expbyte :: n
+  , g_memory :: n
+  , g_txcreate :: n
+  , g_txdatazero :: n
+  , g_txdatanonzero :: n
+  , g_transaction :: n
+  , g_log :: n
+  , g_logdata :: n
+  , g_logtopic :: n
+  , g_sha3 :: n
+  , g_sha3word :: n
+  , g_copy :: n
+  , g_blockhash :: n
+  } deriving Show
+
+-- For the purposes of this module, we define an EIP as just a fee
+-- schedule modification.
+type EIP n = Num n => FeeSchedule n -> FeeSchedule n
+
+-- EIP150: Gas cost changes for IO-heavy operations
+-- <https://github.com/ethereum/EIPs/blob/master/EIPS/eip-150.md>
+eip150 :: EIP n
+eip150 fees = fees
+  { g_extcode = 700
+  , g_balance = 400
+  , g_sload = 200
+  , g_call = 700
+  , r_selfdestruct = 5000
+  , r_selfdestruct_newaccount = 25000
+  }
+
+-- EIP160: EXP cost increase
+-- <https://github.com/ethereum/EIPs/blob/master/EIPS/eip-160.md>
+eip160 :: EIP n
+eip160 fees = fees
+  { g_expbyte = 50 }
+
+homestead :: Num n => FeeSchedule n
+homestead = FeeSchedule
+  { g_zero = 0
+  , g_base = 2
+  , g_verylow = 3
+  , g_low = 5
+  , g_mid = 8
+  , g_high = 10
+  , g_extcode = 20
+  , g_balance = 20
+  , g_sload = 50
+  , g_jumpdest = 1
+  , g_sset = 20000
+  , g_sreset = 5000
+  , r_sclear = 15000
+  , r_selfdestruct = 0
+  , r_selfdestruct_newaccount = 0
+  , g_create = 32000
+  , g_codedeposit = 200
+  , g_call = 40
+  , g_callvalue = 9000
+  , g_callstipend = 2300
+  , g_newaccount = 25000
+  , g_exp = 10
+  , g_expbyte = 10
+  , g_memory = 3
+  , g_txcreate = 32000
+  , g_txdatazero = 4
+  , g_txdatanonzero = 68
+  , g_transaction = 21000
+  , g_log = 375
+  , g_logdata = 8
+  , g_logtopic = 375
+  , g_sha3 = 30
+  , g_sha3word = 6
+  , g_copy = 3
+  , g_blockhash = 20
+  }
+
+metropolis :: Num n => FeeSchedule n
+metropolis = eip160 . eip150 $ homestead
diff --git a/src/EVM/Fetch.hs b/src/EVM/Fetch.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Fetch.hs
@@ -0,0 +1,144 @@
+{-# Language GADTs #-}
+{-# Language StandaloneDeriving #-}
+
+module EVM.Fetch where
+
+import Prelude hiding (Word)
+
+import EVM.Types    (Addr, W256, showAddrWith0x, showWordWith0x, hexText)
+import EVM.Concrete (Word, w256)
+import EVM          (EVM, Contract, initialContract, nonce, balance, external)
+
+import qualified EVM as EVM
+
+import Control.Lens hiding ((.=))
+import Control.Monad.Trans.Maybe
+import Data.Aeson
+import Data.Aeson.Lens
+import Data.ByteString (ByteString)
+import Data.Text (Text, unpack)
+import Network.Wreq
+import Network.Wreq.Session (Session)
+
+import qualified Network.Wreq.Session as Session
+
+-- | Abstract representation of an RPC fetch request
+data RpcQuery a where
+  QueryCode    :: Addr         -> RpcQuery ByteString
+  QueryBalance :: Addr         -> RpcQuery W256
+  QueryNonce   :: Addr         -> RpcQuery W256
+  QuerySlot    :: Addr -> W256 -> RpcQuery W256
+
+data BlockNumber = Latest | BlockNumber W256
+
+deriving instance Show (RpcQuery a)
+
+mkr :: Addr
+mkr = 0xc66ea802717bfb9833400264dd12c2bceaa34a6d
+
+rpc :: String -> [String] -> Value
+rpc method args = object
+  [ "jsonrpc" .= ("2.0" :: String)
+  , "id"      .= Number 1
+  , "method"  .= method
+  , "params"  .= args
+  ]
+
+class ToRPC a where
+  toRPC :: a -> String
+
+instance ToRPC Addr where
+  toRPC = showAddrWith0x
+
+instance ToRPC W256 where
+  toRPC = showWordWith0x
+
+instance ToRPC BlockNumber where
+  toRPC Latest          = "latest"
+  toRPC (BlockNumber n) = showWordWith0x n
+
+readText :: Read a => Text -> a
+readText = read . unpack
+
+fetchQuery
+  :: Show a
+  => BlockNumber
+  -> (Value -> IO (Maybe Text))
+  -> RpcQuery a
+  -> IO (Maybe a)
+fetchQuery n f q = do
+  x <- case q of
+    QueryCode addr -> do
+      fmap hexText  <$>
+        f (rpc "eth_getCode" [toRPC addr, toRPC n])
+    QueryNonce addr ->
+      fmap readText <$>
+        f (rpc "eth_getTransactionCount" [toRPC addr, toRPC n])
+    QueryBalance addr ->
+      fmap readText <$>
+        f (rpc "eth_getBalance" [toRPC addr, toRPC n])
+    QuerySlot addr slot ->
+      fmap readText <$>
+        f (rpc "eth_getStorageAt" [toRPC addr, toRPC slot, toRPC n])
+  return x
+
+fetchWithSession :: Text -> Session -> Value -> IO (Maybe Text)
+fetchWithSession url sess x = do
+  r <- asValue =<< Session.post sess (unpack url) x
+  return (r ^? responseBody . key "result" . _String)
+
+fetchContractWithSession
+  :: BlockNumber -> Text -> Session -> Addr -> IO (Maybe Contract)
+fetchContractWithSession n url sess addr = runMaybeT $ do
+  let
+    fetch :: Show a => RpcQuery a -> IO (Maybe a)
+    fetch = fetchQuery n (fetchWithSession url sess)
+
+  theCode    <- MaybeT $ fetch (QueryCode addr)
+  theNonce   <- MaybeT $ fetch (QueryNonce addr)
+  theBalance <- MaybeT $ fetch (QueryBalance addr)
+
+  return $
+    initialContract theCode
+      & set nonce    (w256 theNonce)
+      & set balance  (w256 theBalance)
+      & set external True
+
+fetchSlotWithSession
+  :: BlockNumber -> Text -> Session -> Addr -> W256 -> IO (Maybe Word)
+fetchSlotWithSession n url sess addr slot = do
+  fmap w256 <$>
+    fetchQuery n (fetchWithSession url sess) (QuerySlot addr slot)
+
+fetchContractFrom :: BlockNumber -> Text -> Addr -> IO (Maybe Contract)
+fetchContractFrom n url addr =
+  Session.withAPISession
+    (flip (fetchContractWithSession n url) addr)
+
+fetchSlotFrom :: BlockNumber -> Text -> Addr -> W256 -> IO (Maybe Word)
+fetchSlotFrom n url addr slot =
+  Session.withAPISession
+    (\s -> fetchSlotWithSession n url s addr slot)
+
+http :: BlockNumber -> Text -> EVM.Query -> IO (EVM ())
+http n url q = do
+  case q of
+    EVM.PleaseFetchContract addr continue ->
+      fetchContractFrom n url addr >>= \case
+        Just x  -> do
+          return (continue x)
+        Nothing -> error ("oracle error: " ++ show q)
+    EVM.PleaseFetchSlot addr slot continue ->
+      fetchSlotFrom n url addr (fromIntegral slot) >>= \case
+        Just x  -> return (continue x)
+        Nothing -> error ("oracle error: " ++ show q)
+
+zero :: Monad m => EVM.Query -> m (EVM ())
+zero q = do
+  case q of
+    EVM.PleaseFetchContract _ continue ->
+      return (continue (initialContract ""))
+    EVM.PleaseFetchSlot _ _ continue ->
+      return (continue 0)
+
+type Fetcher = EVM.Query -> IO (EVM ())
diff --git a/src/EVM/Flatten.hs b/src/EVM/Flatten.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Flatten.hs
@@ -0,0 +1,212 @@
+module EVM.Flatten (flatten) where
+
+-- This module concatenates all the imported dependencies
+-- of a given source file, so that you can paste the result
+-- into Remix or the Etherscan contract verification page.
+--
+-- The concatenated files are stripped of import directives
+-- and compiler version pragmas are merged into just one.
+--
+-- This module is mostly independent from the rest of Hevm,
+-- using only the source code metadata support modules.
+
+import EVM.Dapp (DappInfo, dappSources)
+import EVM.Solidity (sourceAsts)
+
+-- We query and alter the Solidity code using the compiler's AST.
+-- The AST is a deep JSON structure, so we use Aeson and Lens.
+import Control.Lens (preview, view, universe)
+import Data.Aeson (Value (String))
+import Data.Aeson.Lens (key, _String, _Array)
+
+-- We use the FGL graph library for the topological sort.
+-- (We use four FGL functions and they're all in different modules!)
+import qualified Data.Graph.Inductive.Graph as Fgl
+import qualified Data.Graph.Inductive.PatriciaTree as Fgl
+import qualified Data.Graph.Inductive.Query.BFS as Fgl
+import qualified Data.Graph.Inductive.Query.DFS as Fgl
+
+import Control.Monad (forM)
+import Data.ByteString (ByteString)
+import Data.Foldable (foldl', toList)
+import Data.List (sort)
+import Data.Map (Map, (!))
+import Data.Maybe (mapMaybe, isJust, fromMaybe)
+import Data.Monoid ((<>))
+import Data.Text (Text, unpack, pack, intercalate)
+import Data.Text.Encoding (encodeUtf8)
+import Text.Read (readMaybe)
+
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import qualified Data.ByteString as BS
+
+-- Define an alias for FGL graphs with text nodes and unlabeled edges.
+type FileGraph = Fgl.Gr Text ()
+
+-- Given the AST of a source file, resolve all its imported paths.
+importsFrom :: Value -> [Text]
+importsFrom ast =
+  let
+    -- We use the astonishing `universe` function from Lens
+    -- to get a lazy list of every node in the AST structure.
+    allNodes :: [Value]
+    allNodes = universe ast
+
+    -- Given some subvalue in the AST, we check if it's an import,
+    -- and if so, return its resolved import path.
+    resolveImport :: Value -> Maybe Text
+    resolveImport node =
+      case preview (key "name") node of
+        Just (String "ImportDirective") ->
+          preview (key "attributes" . key "absolutePath" . _String) node
+        _ ->
+          Nothing
+
+  -- Now we just try to resolve import paths at all subnodes.
+  in mapMaybe resolveImport allNodes
+
+flatten :: DappInfo -> Text -> IO ()
+flatten dapp target = do
+  let
+    -- The nodes and edges are defined below.
+    graph :: FileGraph
+    graph = Fgl.mkGraph nodes edges
+
+    -- The graph nodes are ints with source paths as labels.
+    nodes :: [(Int, Text)]
+    nodes = zip [1..] (Map.keys asts)
+
+    -- The graph edges are defined by module imports.
+    edges =
+      [ (indices ! s, indices ! t, ()) -- Edge from S to T
+      | (s, v) <- Map.toList asts      -- for every file S
+      , t      <- importsFrom v ]      -- and every T imported by S.
+
+    -- We can look up the node index for a source file path.
+    indices :: Map Text Int
+    indices = Map.fromList [(v, k) | (k, v) <- nodes]
+
+    -- The JSON ASTs are indexed by source file path.
+    asts :: Map Text Value
+    asts = view (dappSources . sourceAsts) dapp
+
+  -- We use the target source file to make a relevant subgraph
+  -- with only files transitively depended on from the target.
+  case Map.lookup target indices of
+    Nothing ->
+      error "didn't find contract AST"
+    Just root -> do
+      let
+        -- Restrict the graph to only the needed nodes,
+        -- discovered via breadth-first search from the target.
+        subgraph :: Fgl.Gr Text ()
+        subgraph = Fgl.subgraph (Fgl.bfs root graph) graph
+
+        -- Now put the source file paths in the right order
+        -- by sorting topologically.
+        ordered :: [Text]
+        ordered = reverse (Fgl.topsort' subgraph)
+
+        -- Take the highest Solidity version from all pragmas.
+        pragma :: Text
+        pragma = maximalPragma (Map.elems asts)
+
+      -- Read the source files in order and strip unwanted directives.
+      -- Also add an informative comment with the original source file path.
+      sources <-
+        forM ordered $ \path -> do
+          src <- BS.readFile (unpack path)
+          pure $ mconcat
+            [ "////// ", encodeUtf8 path, "\n"
+            , stripImportsAndPragmas src (asts ! path), "\n"
+            ]
+
+      -- Finally print the whole concatenation.
+      putStrLn $ "// hevm: flattened sources of " <> unpack target
+      putStrLn (unpack pragma)
+      BS.putStr (mconcat sources)
+
+-- Construct a new Solidity version pragma for the highest mentioned version
+-- given a list of source file ASTs.
+maximalPragma :: [Value] -> Text
+maximalPragma asts =
+  case mapMaybe versions asts of
+    [] -> error "no Solidity version pragmas in any source files"
+    xs ->
+      "pragma solidity ^"
+        <> intercalate "." (map (pack . show) (maximum xs))
+        <> ";\n"
+
+  where
+    -- Get the version components from a source file's pragma,
+    -- or nothing if no pragma present.
+    versions :: Value -> Maybe [Int]
+    versions ast = fmap grok components
+      where
+        pragma :: Maybe Value
+        pragma =
+          case filter (nodeIs "PragmaDirective") (universe ast) of
+            [x] -> Just x
+            []  -> Nothing
+            _   -> error "multiple version pragmas"
+
+        components :: Maybe [Value]
+        components = fmap toList
+          (pragma >>= preview (key "attributes" . key "literals" . _Array))
+
+        grok :: [Value] -> [Int]
+        grok = \case
+          [String "solidity", String _prefix, String a, String b] ->
+            map
+              (fromMaybe
+                 (error . Text.unpack $ "bad Solidity version: " <> a <> b)
+                 . readAs)
+              (Text.splitOn "." (a <> b))
+          x ->
+            error ("unrecognized pragma: " ++ show x)
+
+nodeIs :: Text -> Value -> Bool
+nodeIs t x = isSourceNode && hasRightName
+  where
+    isSourceNode =
+      isJust (preview (key "src") x)
+    hasRightName =
+      Just t == preview (key "name" . _String) x
+
+stripImportsAndPragmas :: ByteString -> Value -> ByteString
+stripImportsAndPragmas bs ast = stripAstNodes bs ast p
+  where
+    p x = nodeIs "ImportDirective" x || nodeIs "PragmaDirective" x
+
+stripAstNodes :: ByteString -> Value -> (Value -> Bool) -> ByteString
+stripAstNodes bs ast p =
+  cutRanges [sourceRange node | node <- universe ast, p node]
+
+  where
+    -- Parses the `src` field of an AST node into a pair of byte indices.
+    sourceRange :: Value -> (Int, Int)
+    sourceRange v =
+      case preview (key "src" . _String) v of
+        Just (Text.splitOn ":" -> [readAs -> Just i, readAs -> Just n, _]) ->
+          (i, i + n)
+        _ ->
+          error "internal error: no source position for AST node"
+
+    -- Removes a set of non-overlapping ranges from a bytestring
+    -- by commenting them out.
+    cutRanges :: [(Int, Int)] -> ByteString
+    cutRanges (sort -> rs) = fst (foldl' f (bs, 0) rs)
+      where
+        f (bs', n) (i, j) =
+          ( cut bs' (i + n) (j + n)
+          , n + length ("/*  */" :: String))
+
+    -- Comments out the bytes between two indices from a bytestring.
+    cut :: ByteString -> Int -> Int -> ByteString
+    cut x i j =
+      let (a, b) = BS.splitAt i x
+      in a <> "/* " <> BS.take (j - i) b <> " */" <> BS.drop (j - i) b
+
+readAs :: Read a => Text -> Maybe a
+readAs = readMaybe . Text.unpack
diff --git a/src/EVM/Format.hs b/src/EVM/Format.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Format.hs
@@ -0,0 +1,280 @@
+module EVM.Format where
+
+import Prelude hiding (Word)
+
+import EVM (VM, cheatCode, traceForest, traceData)
+import EVM (Trace, TraceData (..), Log (..), Query (..), FrameContext (..))
+import EVM.Dapp (DappInfo, dappSolcByHash, showTraceLocation, dappEventMap)
+import EVM.Concrete (Word (..), Blob (..))
+import EVM.Types (W256 (..), num)
+import EVM.ABI (AbiValue (..), Event (..), AbiType (..))
+import EVM.ABI (Indexed (Indexed, NotIndexed), getAbiSeq, getAbi)
+import EVM.ABI (abiTypeSolidity, parseTypeName)
+import EVM.Solidity (SolcContract, contractName, abiMap)
+import EVM.Solidity (methodOutput, methodSignature)
+import EVM.Concrete (forceConcreteBlob, forceConcreteWord)
+
+import Control.Arrow ((>>>))
+import Control.Lens (view, preview, ix, _2, to, _Just)
+import Data.Binary.Get (runGetOrFail)
+import Data.ByteString (ByteString)
+import Data.ByteString.Builder (byteStringHex, toLazyByteString)
+import Data.ByteString.Lazy (toStrict, fromStrict)
+import Data.DoubleWord (signedWord)
+import Data.Foldable (toList)
+import Data.Map (Map)
+import Data.Maybe (catMaybes)
+import Data.Monoid ((<>))
+import Data.Text (Text, pack, unpack, intercalate)
+import Data.Text (dropEnd, splitOn)
+import Data.Text.Encoding (decodeUtf8, decodeUtf8')
+import Data.Tree.View (showTree)
+import Data.Vector (Vector)
+
+import Numeric (showHex)
+
+import qualified Data.ByteString as BS
+import qualified Data.Char as Char
+import qualified Data.Map as Map
+import qualified Data.Scientific as Scientific
+import qualified Data.Text as Text
+
+data Signedness = Signed | Unsigned
+
+showDec :: Signedness -> W256 -> Text
+showDec signed (W256 w) =
+  let
+    i = case signed of
+          Signed   -> num (signedWord w)
+          Unsigned -> num w
+
+  in
+    if i == num cheatCode
+    then "<hevm cheat address>"
+    else
+      if abs i > 1000000000000
+      then
+        "~" <> pack (Scientific.formatScientific
+                       Scientific.Generic
+                       (Just 8)
+                       (fromIntegral i))
+      else
+        showDecExact i
+
+showDecExact :: Integer -> Text
+showDecExact = humanizeInteger
+
+showWordExact :: Word -> Text
+showWordExact (C _ (W256 w)) = humanizeInteger w
+
+humanizeInteger :: (Num a, Integral a, Show a) => a -> Text
+humanizeInteger =
+  ( Text.intercalate ","
+  . reverse
+  . map Text.reverse
+  . Text.chunksOf 3
+  . Text.reverse
+  . Text.pack
+  . show
+  )
+
+-- TODO: make polymorphic
+showAbiValues :: Vector AbiValue -> Text
+showAbiValues vs =
+  "(" <> intercalate ", " (toList (fmap showAbiValue vs)) <> ")"
+
+showAbiArray :: Vector AbiValue -> Text
+showAbiArray vs =
+  "[" <> intercalate ", " (toList (fmap showAbiValue vs)) <> "]"
+
+showAbiValue :: AbiValue -> Text
+showAbiValue (AbiUInt _ w) =
+  pack $ show w
+showAbiValue (AbiInt _ w) =
+  pack $ show w
+showAbiValue (AbiBool b) =
+  pack $ show b
+showAbiValue (AbiAddress w160) =
+  pack $ "0x" ++ (showHex w160 "")
+showAbiValue (AbiBytes _ bs) =
+  formatBytes bs
+showAbiValue (AbiBytesDynamic bs) =
+  formatBinary bs
+showAbiValue (AbiString bs) =
+  formatQString bs
+showAbiValue (AbiArray _ _ xs) =
+  showAbiArray xs
+showAbiValue (AbiArrayDynamic _ xs) =
+  showAbiArray xs
+
+isPrintable :: ByteString -> Bool
+isPrintable =
+  decodeUtf8' >>>
+    either (const False)
+      (Text.all (not . Char.isControl))
+
+formatBytes :: ByteString -> Text
+formatBytes b =
+  let (s, _) = BS.spanEnd (== 0) b
+  in
+    if isPrintable s
+    then formatQString s
+    else formatBinary b
+
+formatQString :: ByteString -> Text
+formatQString = pack . show
+
+formatString :: ByteString -> Text
+formatString bs = decodeUtf8 (fst (BS.spanEnd (== 0) bs))
+
+formatBinary :: ByteString -> Text
+formatBinary =
+  (<>) "0x" . decodeUtf8 . toStrict . toLazyByteString . byteStringHex
+
+showTraceTree :: DappInfo -> VM -> Text
+showTraceTree dapp =
+  traceForest
+    >>> fmap (fmap (unpack . showTrace dapp))
+    >>> concatMap showTree
+    >>> pack
+
+showTrace :: DappInfo -> Trace -> Text
+showTrace dapp trace =
+  let
+    pos =
+      case showTraceLocation dapp trace of
+        Left x -> " \x1b[90m" <> x <> "\x1b[0m"
+        Right x -> " \x1b[90m(" <> x <> ")\x1b[0m"
+  in case view traceData trace of
+    EventTrace (Log _ bytes topics) ->
+      case topics of
+        (t:_) ->
+          formatLog
+            (getEvent t (view dappEventMap dapp))
+            (forceConcreteBlob bytes) <> pos
+        _ ->
+          "log" <> pos
+    QueryTrace q ->
+      case q of
+        PleaseFetchContract addr _ ->
+          "fetch contract " <> pack (show addr) <> pos
+        PleaseFetchSlot addr slot _ ->
+          "fetch storage slot " <> pack (show slot) <> " from " <> pack (show addr) <> pos
+    ErrorTrace e ->
+      "\x1b[91merror\x1b[0m " <> pack (show e) <> pos
+
+    ReturnTrace output (CallContext _ _ hash (Just abi) _ _) ->
+      case getAbiMethodOutput dapp hash abi of
+        Nothing ->
+          "← " <> formatBinary (forceConcreteBlob output)
+        Just (_, t) ->
+          "← " <> abiTypeSolidity t <> " " <> showValue t (forceConcreteBlob output)
+    ReturnTrace output (CallContext {}) ->
+      "← " <> formatBinary (forceConcreteBlob output)
+    ReturnTrace _ (CreationContext {}) ->
+      error "internal error: shouldn't show returns for creates"
+
+    EntryTrace t ->
+      t
+    FrameTrace (CreationContext hash) ->
+      "create " <> maybeContractName (preview (dappSolcByHash . ix hash . _2) dapp) <> pos
+    FrameTrace (CallContext _ _ hash abi calldata _) ->
+      case preview (dappSolcByHash . ix hash . _2) dapp of
+        Nothing ->
+          "call [unknown]" <> pos
+        Just solc ->
+          "call "
+            <> "\x1b[1m"
+            <> view (contractName . to contractNamePart) solc
+            <> "::"
+            <> maybe ("[fallback function]")
+                 (\x -> maybe "[unknown method]" id (maybeAbiName solc x))
+                 abi
+            <> maybe ("(" <> formatBinary (forceConcreteBlob calldata) <> ")")
+                 -- todo: if unknown method, then just show raw calldata
+                 (\x -> showCall (catMaybes x) (forceConcreteBlob calldata))
+                 (abi >>= fmap getAbiTypes . maybeAbiName solc)
+            <> "\x1b[0m"
+            <> pos
+
+getAbiMethodOutput
+  :: DappInfo -> W256 -> Word -> Maybe (Text, AbiType)
+getAbiMethodOutput dapp hash abi =
+  -- Some typical ugly lens code. :'(
+  preview
+    ( dappSolcByHash . ix hash . _2 . abiMap
+    . ix (fromIntegral abi) . methodOutput . _Just
+    )
+    dapp
+
+getAbiTypes :: Text -> [Maybe AbiType]
+getAbiTypes abi = map parseTypeName types
+  where
+    types =
+      filter (/= "") $
+        splitOn "," (dropEnd 1 (last (splitOn "(" abi)))
+
+showCall :: [AbiType] -> ByteString -> Text
+showCall ts bs =
+  case runGetOrFail (getAbiSeq (length ts) ts)
+         (fromStrict (BS.drop 4 bs)) of
+    Right (_, _, xs) -> showAbiValues xs
+    Left (_, _, _)   -> formatBinary bs
+
+showValue :: AbiType -> ByteString -> Text
+showValue t bs =
+  case runGetOrFail (getAbi t) (fromStrict bs) of
+    Right (_, _, x) -> showAbiValue x
+    Left (_, _, _)  -> formatBinary bs
+
+maybeContractName :: Maybe SolcContract -> Text
+maybeContractName =
+  maybe "<unknown contract>" (view (contractName . to contractNamePart))
+
+maybeAbiName :: SolcContract -> Word -> Maybe Text
+maybeAbiName solc abi = preview (abiMap . ix (fromIntegral abi) . methodSignature) solc
+
+contractNamePart :: Text -> Text
+contractNamePart x = Text.split (== ':') x !! 1
+
+contractPathPart :: Text -> Text
+contractPathPart x = Text.split (== ':') x !! 0
+
+-- TODO: this should take Log
+formatLog :: Maybe Event -> ByteString -> Text
+formatLog event args =
+  let types = getEventUnindexedTypes event
+      name  = getEventName event
+  in
+  case runGetOrFail (getAbiSeq (length types) types)
+                      (fromStrict args) of
+                    Right (_, _, abivals) ->
+                      mconcat
+                        [ "\x1b[36m"
+                        , name
+                        , showAbiValues abivals
+                        , "\x1b[0m"
+                        ]
+                    Left (_,_,_) ->
+                      error "lol"
+
+getEvent :: Word -> Map W256 Event -> Maybe Event
+getEvent w events = Map.lookup (forceConcreteWord w) events
+
+getEventName :: Maybe Event -> Text
+getEventName (Just (Event name _ _)) = name
+getEventName Nothing = "<unknown-event>"
+
+getEventUnindexedTypes :: Maybe Event -> [AbiType]
+getEventUnindexedTypes Nothing = []
+getEventUnindexedTypes (Just (Event _ _ xs)) = [x | (x, NotIndexed) <- xs]
+
+getEventIndexedTypes :: Maybe Event -> [AbiType]
+getEventIndexedTypes Nothing = []
+getEventIndexedTypes (Just (Event _ _ xs)) = [x | (x, Indexed) <- xs]
+
+getEventArgs :: Blob -> Text
+getEventArgs b = formatBlob b
+
+formatBlob :: Blob -> Text
+formatBlob b = decodeUtf8 $ forceConcreteBlob b
diff --git a/src/EVM/Keccak.hs b/src/EVM/Keccak.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Keccak.hs
@@ -0,0 +1,102 @@
+{-# Language CPP #-}
+
+#ifdef __GHCJS__
+{-# Language JavaScriptFFI #-}
+#endif
+
+module EVM.Keccak (keccak, abiKeccak, newContractAddress) where
+
+import EVM.Types
+
+import Control.Arrow ((>>>))
+
+import Data.Bits
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.Word
+
+#ifdef __GHCJS__
+import qualified Data.JSString as JS
+import qualified Data.Text.Encoding as Text
+import qualified Data.Text as Text
+import qualified Data.ByteString.Base64 as BS64
+
+foreign import javascript unsafe
+  "keccakBase64($1)"
+  keccakBase64 :: JS.JSString -> JS.JSString
+
+keccakBytes =
+  BS64.encode
+    >>> Text.decodeUtf8
+    >>> Text.unpack
+    >>> JS.pack
+    >>> keccakBase64
+    >>> JS.unpack
+    >>> Text.pack
+    >>> Text.encodeUtf8
+    >>> BS64.decodeLenient
+
+#else
+import Crypto.Hash
+import qualified Data.ByteArray as BA
+
+keccakBytes =
+  (hash :: ByteString -> Digest Keccak_256)
+    >>> BA.unpack
+    >>> BS.pack
+
+#endif
+
+keccakBytes :: ByteString -> ByteString
+
+word32 :: [Word8] -> Word32
+word32 xs = sum [ fromIntegral x `shiftL` (8*n)
+                | (n, x) <- zip [0..] (reverse xs) ]
+
+octets :: W256 -> [Word8]
+octets x =
+  dropWhile (== 0) [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..31]]
+
+octets160 :: Addr -> [Word8]
+octets160 x =
+  dropWhile (== 0) [fromIntegral (shiftR x (8 * i)) | i <- reverse [0..19]]
+
+keccak :: ByteString -> W256
+keccak =
+  keccakBytes
+    >>> BS.take 32
+    >>> word
+
+abiKeccak :: ByteString -> Word32
+abiKeccak =
+  keccakBytes
+    >>> BS.take 4
+    >>> BS.unpack
+    >>> word32
+
+rlpWord256 :: W256 -> ByteString
+rlpWord256 0 = BS.pack [0x80]
+rlpWord256 x | x <= 0x7f = BS.pack [fromIntegral x]
+rlpWord256 x =
+  let xs = octets x
+  in BS.pack ([0x80 + fromIntegral (length xs)] ++ xs)
+
+rlpWord160 :: Addr -> ByteString
+rlpWord160 0 = BS.pack [0x80]
+rlpWord160 x =
+  let xs = octets160 x
+  in BS.pack ([0x80 + fromIntegral (length xs)] ++ xs)
+
+rlpList :: [ByteString] -> ByteString
+rlpList xs =
+  let n = sum (map BS.length xs)
+  in if n <= 55
+     then BS.cons (fromIntegral (0xc0 + n)) (BS.concat xs)
+     else
+       let ns = rlpWord256 (fromIntegral n)
+       in BS.cons (fromIntegral (0xf7 + BS.length ns)) (BS.concat (ns : xs))
+
+newContractAddress :: Addr -> W256 -> Addr
+newContractAddress a n =
+  fromIntegral
+    (keccak $ rlpList [rlpWord160 a, rlpWord256 n])
diff --git a/src/EVM/Op.hs b/src/EVM/Op.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Op.hs
@@ -0,0 +1,76 @@
+module EVM.Op (Op (..)) where
+
+import EVM.Types (W256)
+import Data.Word (Word8)
+
+data Op
+  = OpStop
+  | OpAdd
+  | OpMul
+  | OpSub
+  | OpDiv
+  | OpSdiv
+  | OpMod
+  | OpSmod
+  | OpAddmod
+  | OpMulmod
+  | OpExp
+  | OpSignextend
+  | OpLt
+  | OpGt
+  | OpSlt
+  | OpSgt
+  | OpEq
+  | OpIszero
+  | OpAnd
+  | OpOr
+  | OpXor
+  | OpNot
+  | OpByte
+  | OpSha3
+  | OpAddress
+  | OpBalance
+  | OpOrigin
+  | OpCaller
+  | OpCallvalue
+  | OpCalldataload
+  | OpCalldatasize
+  | OpCalldatacopy
+  | OpCodesize
+  | OpCodecopy
+  | OpGasprice
+  | OpExtcodesize
+  | OpExtcodecopy
+  | OpReturndatasize
+  | OpReturndatacopy
+  | OpBlockhash
+  | OpCoinbase
+  | OpTimestamp
+  | OpNumber
+  | OpDifficulty
+  | OpGaslimit
+  | OpPop
+  | OpMload
+  | OpMstore
+  | OpMstore8
+  | OpSload
+  | OpSstore
+  | OpJump
+  | OpJumpi
+  | OpPc
+  | OpMsize
+  | OpGas
+  | OpJumpdest
+  | OpCreate
+  | OpCall
+  | OpCallcode
+  | OpReturn
+  | OpDelegatecall
+  | OpRevert
+  | OpSelfdestruct
+  | OpDup !Word8
+  | OpSwap !Word8
+  | OpLog !Word8
+  | OpPush !W256
+  | OpUnknown Word8
+  deriving (Show, Eq)
diff --git a/src/EVM/Precompiled.hs b/src/EVM/Precompiled.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Precompiled.hs
@@ -0,0 +1,65 @@
+{-# Language ForeignFunctionInterface #-}
+
+module EVM.Precompiled (execute) where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+
+import Foreign.C
+import Foreign.Ptr
+import Foreign.ForeignPtr
+
+import System.IO.Unsafe
+
+-- | Opaque representation of the C library's context struct.
+data EthjetContext
+
+foreign import ccall "ethjet_init"
+  ethjet_init :: IO (Ptr EthjetContext)
+foreign import ccall "&ethjet_free"
+  ethjet_free :: FunPtr (Ptr EthjetContext -> IO ())
+foreign import ccall "ethjet"
+  ethjet
+    :: Ptr EthjetContext     -- initialized context
+    -> CInt                  -- operation
+    -> Ptr CChar -> CInt     -- input
+    -> Ptr CChar -> CInt     -- output
+    -> IO CInt               -- 1 if good
+
+-- Lazy evaluation ensures this context is only initialized once,
+-- and `unsafePerformIO` in such situations is a common pattern.
+--
+-- We use a "foreign pointer" annotated with a finalizer.
+globalContext :: ForeignPtr EthjetContext
+{-# NOINLINE globalContext #-}
+globalContext =
+  unsafePerformIO $
+    ethjet_init >>= newForeignPtr ethjet_free
+
+-- | Run a given precompiled contract using the C library.
+execute
+  :: Int                -- ^ The number of the precompiled contract
+  -> ByteString         -- ^ The input buffer
+  -> Int                -- ^ The desired output size
+  -> Maybe ByteString   -- ^ Hopefully, the output buffer
+execute contract input outputSize =
+
+  -- This code looks messy because of the pointer handling,
+  -- but it's actually simple.
+  --
+  -- We use `unsafePerformIO` because the contracts are pure.
+
+  unsafePerformIO . BS.useAsCStringLen input $
+    \(inputPtr, inputSize) -> do
+       outputForeignPtr <- mallocForeignPtrBytes outputSize
+       withForeignPtr outputForeignPtr $ \outputPtr -> do
+         status <-
+           withForeignPtr globalContext $ \contextPtr ->
+             -- Finally, we can invoke the C library.
+             ethjet contextPtr (fromIntegral contract)
+               inputPtr (fromIntegral inputSize)
+               outputPtr (fromIntegral outputSize)
+
+         case status of
+           1 -> Just <$> BS.packCStringLen (outputPtr, outputSize)
+           _ -> pure Nothing
diff --git a/src/EVM/Solidity.hs b/src/EVM/Solidity.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Solidity.hs
@@ -0,0 +1,372 @@
+{-# Language DeriveAnyClass #-}
+{-# Language StrictData #-}
+{-# Language TemplateHaskell #-}
+
+module EVM.Solidity
+  ( solidity
+  , JumpType (..)
+  , SolcContract (..)
+  , SourceCache (..)
+  , SrcMap (..)
+  , CodeType (..)
+  , Method (..)
+  , methodName
+  , methodSignature
+  , methodInputs
+  , methodOutput
+  , abiMap
+  , eventMap
+  , contractName
+  , creationCode
+  , makeSrcMaps
+  , readSolc
+  , runtimeCode
+  , snippetCache
+  , runtimeCodehash
+  , creationCodehash
+  , runtimeSrcmap
+  , creationSrcmap
+  , contractAst
+  , sourceFiles
+  , sourceLines
+  , sourceAsts
+  , stripBytecodeMetadata
+  , lineSubrange
+  , astIdMap
+  , astSrcMap
+) where
+
+import EVM.ABI
+import EVM.Keccak
+import EVM.Types
+
+import Control.Applicative
+import Control.Lens         hiding (Indexed)
+import Data.Aeson           (Value (..))
+import Data.Aeson.Lens
+import Data.ByteString      (ByteString)
+import Data.Char            (isDigit, digitToInt)
+import Data.Foldable
+import Data.Map.Strict      (Map)
+import Data.Maybe
+import Data.Monoid
+import Data.Sequence        (Seq)
+import Data.Text            (Text, pack, intercalate)
+import Data.Text.Encoding   (encodeUtf8)
+import Data.Text.IO         (readFile, writeFile)
+import Data.Vector          (Vector)
+import Data.Word
+import GHC.Generics         (Generic)
+import Prelude hiding       (readFile, writeFile)
+import System.IO hiding     (readFile, writeFile)
+import System.IO.Temp
+import System.Process
+import Text.Read            (readMaybe)
+
+import qualified Data.ByteString        as BS
+import qualified Data.ByteString.Base16 as BS16
+import qualified Data.HashMap.Strict    as HMap
+import qualified Data.Map.Strict        as Map
+import qualified Data.Text              as Text
+import qualified Data.Vector            as Vector
+
+data SolcContract = SolcContract
+  { _runtimeCodehash  :: W256
+  , _creationCodehash :: W256
+  , _runtimeCode      :: ByteString
+  , _creationCode     :: ByteString
+  , _contractName     :: Text
+  , _abiMap           :: Map Word32 Method
+  , _eventMap         :: Map W256 Event
+  , _runtimeSrcmap    :: Seq SrcMap
+  , _creationSrcmap   :: Seq SrcMap
+  , _contractAst      :: Value
+  } deriving (Show, Eq, Generic)
+
+data Method = Method
+  { _methodOutput :: Maybe (Text, AbiType)
+  , _methodInputs :: [(Text, AbiType)]
+  , _methodName :: Text
+  , _methodSignature :: Text
+  } deriving (Show, Eq, Ord, Generic)
+
+data SourceCache = SourceCache
+  { _snippetCache :: Map (Int, Int) ByteString
+  , _sourceFiles  :: Map Int (Text, ByteString)
+  , _sourceLines  :: Map Int (Vector ByteString)
+  , _sourceAsts   :: Map Text Value
+  } deriving (Show, Eq, Generic)
+
+instance Monoid SourceCache where
+  mempty = SourceCache mempty mempty mempty mempty
+  mappend (SourceCache _ _ _ _) (SourceCache _ _ _ _) = error "lol"
+
+data JumpType = JumpInto | JumpFrom | JumpRegular
+  deriving (Show, Eq, Ord, Generic)
+
+data SrcMap = SM {
+  srcMapOffset :: {-# UNPACK #-} Int,
+  srcMapLength :: {-# UNPACK #-} Int,
+  srcMapFile   :: {-# UNPACK #-} Int,
+  srcMapJump   :: JumpType
+} deriving (Show, Eq, Ord, Generic)
+
+data SrcMapParseState
+  = F1 [Int] Int
+  | F2 Int [Int] Int
+  | F3 Int Int [Int] Int
+  | F4 Int Int Int
+  | F5 SrcMap
+  | Fe
+  deriving Show
+
+data CodeType = Creation | Runtime
+  deriving (Show, Eq, Ord)
+
+makeLenses ''SolcContract
+makeLenses ''SourceCache
+makeLenses ''Method
+
+-- Obscure but efficient parser for the Solidity sourcemap format.
+makeSrcMaps :: Text -> Maybe (Seq SrcMap)
+makeSrcMaps = (\case (_, Fe, _) -> Nothing; x -> Just (done x))
+             . Text.foldl' (\x y -> go y x) (mempty, F1 [] 1, SM 0 0 0 JumpRegular)
+  where
+    digits ds = digits' (0 :: Int) (0 :: Int) ds
+    digits' !x _ []      = x
+    digits' !x !n (d:ds) = digits' (x + d * 10 ^ n) (n + 1) ds
+
+    done (xs, s, p) = let (xs', _, _) = go ';' (xs, s, p) in xs'
+
+    go ':' (xs, F1 [] _, p@(SM a _ _ _))       = (xs, F2 a [] 1, p)
+    go ':' (xs, F1 ds k, p)                    = (xs, F2 (k * digits ds) [] 1, p)
+    go '-' (xs, F1 [] _, p)                    = (xs, F1 [] (-1), p)
+    go d   (xs, F1 ds k, p) | isDigit d        = (xs, F1 (digitToInt d : ds) k, p)
+    go ';' (xs, F1 [] k, p)                    = (xs |> p, F1 [] k, p)
+    go ';' (xs, F1 ds k, SM _ b c d)           = let p' = SM (k * digits ds) b c d in
+                                                 (xs |> p', F1 [] 1, p')
+
+    go '-' (xs, F2 a [] _, p)                  = (xs, F2 a [] (-1), p)
+    go d   (xs, F2 a ds k, p) | isDigit d      = (xs, F2 a (digitToInt d : ds) k, p)
+    go ':' (xs, F2 a [] _, p@(SM _ b _ _))     = (xs, F3 a b [] 1, p)
+    go ':' (xs, F2 a ds k, p)                  = (xs, F3 a (k * digits ds) [] 1, p)
+    go ';' (xs, F2 a [] _, SM _ b c d)         = let p' = SM a b c d in (xs |> p', F1 [] 1, p')
+    go ';' (xs, F2 a ds k, SM _ _ c d)         = let p' = SM a (k * digits ds) c d in
+                                                 (xs |> p', F1 [] 1, p')
+
+    go d   (xs, F3 a b ds k, p) | isDigit d  = (xs, F3 a b (digitToInt d : ds) k, p)
+    go '-' (xs, F3 a b [] _, p)              = (xs, F3 a b [] (-1), p)
+    go ':' (xs, F3 a b [] _, p@(SM _ _ c _)) = (xs, F4 a b c, p)
+    go ':' (xs, F3 a b ds k, p)              = (xs, F4 a b (k * digits ds), p)
+    go ';' (xs, F3 a b [] _, SM _ _ c d)     = let p' = SM a b c d in (xs |> p', F1 [] 1, p')
+    go ';' (xs, F3 a b ds k, SM _ _ _ d)     = let p' = SM a b (k * digits ds) d in
+                                               (xs |> p', F1 [] 1, p')
+
+    go 'i' (xs, F4 a b c, p)                 = (xs, F5 (SM a b c JumpInto), p)
+    go 'o' (xs, F4 a b c, p)                 = (xs, F5 (SM a b c JumpFrom), p)
+    go '-' (xs, F4 a b c, p)                 = (xs, F5 (SM a b c JumpRegular), p)
+    go ';' (xs, F5 s, _)                     = (xs |> s, F1 [] 1, s)
+
+    go c (xs, _, p)                          = (xs, error ("srcmap: y u " ++ show c ++ "?!?"), p)
+
+makeSourceCache :: [Text] -> Map Text Value -> IO SourceCache
+makeSourceCache paths asts = do
+  xs <- mapM (BS.readFile . Text.unpack) paths
+  return $! SourceCache
+    { _snippetCache = mempty
+    , _sourceFiles =
+        Map.fromList (zip [0..] (zip paths xs))
+    , _sourceLines =
+        Map.fromList (zip [0 .. length paths - 1]
+                       (map (Vector.fromList . BS.split 0xa) xs))
+    , _sourceAsts =
+        asts
+    }
+
+lineSubrange ::
+  Vector ByteString -> (Int, Int) -> Int -> Maybe (Int, Int)
+lineSubrange xs (s1, n1) i =
+  let
+    ks = Vector.map (\x -> 1 + BS.length x) xs
+    s2  = Vector.sum (Vector.take i ks)
+    n2  = ks Vector.! i
+  in
+    if s1 + n1 < s2 || s1 > s2 + n2
+    then Nothing
+    else Just (s1 - s2, min (s2 + n2 - s1) n1)
+
+readSolc :: FilePath -> IO (Maybe (Map Text SolcContract, SourceCache))
+readSolc fp =
+  (readJSON <$> readFile fp) >>=
+    \case
+      Nothing -> return Nothing
+      Just (contracts, asts, sources) -> do
+        sourceCache <- makeSourceCache sources asts
+        return $! Just (contracts, sourceCache)
+
+solidity :: Text -> Text -> IO (Maybe ByteString)
+solidity contract src = do
+  (json, path) <- solidity' src
+  let Just (solc, _, _) = readJSON json
+  return (solc ^? ix (path <> ":" <> contract) . creationCode)
+
+force :: String -> Maybe a -> a
+force s = fromMaybe (error s)
+
+readJSON :: Text -> Maybe (Map Text SolcContract, Map Text Value, [Text])
+readJSON json = do
+  contracts <-
+    f <$> (json ^? key "contracts" . _Object)
+      <*> (fmap (fmap (^. _String)) $ json ^? key "sourceList" . _Array)
+  sources <- toList . fmap (view _String) <$> json ^? key "sourceList" . _Array
+  return (contracts, Map.fromList (HMap.toList asts), sources)
+  where
+    asts = fromMaybe (error "JSON lacks abstract syntax trees.") (json ^? key "sources" . _Object)
+    f x y = Map.fromList . map (g y) . HMap.toList $ x
+    g _ (s, x) =
+      let
+        theRuntimeCode = toCode (x ^?! key "bin-runtime" . _String)
+        theCreationCode = toCode (x ^?! key "bin" . _String)
+      in (s, SolcContract {
+        _runtimeCode      = theRuntimeCode,
+        _creationCode     = theCreationCode,
+        _runtimeCodehash  = keccak (stripBytecodeMetadata theRuntimeCode),
+        _creationCodehash = keccak (stripBytecodeMetadata theCreationCode),
+        _runtimeSrcmap    = force "internal error: srcmap-runtime" (makeSrcMaps (x ^?! key "srcmap-runtime" . _String)),
+        _creationSrcmap   = force "internal error: srcmap" (makeSrcMaps (x ^?! key "srcmap" . _String)),
+        _contractName = s,
+        _contractAst =
+          fromMaybe
+            (error "JSON lacks abstract syntax trees.")
+            (preview (ix (Text.split (== ':') s !! 0) . key "AST") asts),
+        _abiMap       = Map.fromList $
+          let
+            abis =
+              toList ((x ^?! key "abi" . _String) ^?! _Array)
+            relevant =
+              filter (\y -> "function" == y ^?! key "type" . _String) abis
+          in flip map relevant $
+            \abi -> (
+              abiKeccak (encodeUtf8 (signature abi)),
+              Method
+                { _methodName = abi ^?! key "name" . _String
+                , _methodSignature = signature abi
+                , _methodInputs =
+                    map parseMethodInput
+                      (toList (abi ^?! key "inputs" . _Array))
+                , _methodOutput =
+                    fmap parseMethodInput
+                      (abi ^? key "outputs" . _Array . ix 0)
+                }
+            ),
+        _eventMap     = Map.fromList $
+          flip map (filter (\y -> "event" == y ^?! key "type" . _String)
+                     . toList $ (x ^?! key "abi" . _String) ^?! _Array) $
+            \abi ->
+              ( keccak (encodeUtf8 (signature abi))
+              , Event
+                  (abi ^?! key "name" . _String)
+                  (case abi ^?! key "anonymous" . _Bool of
+                     True -> Anonymous
+                     False -> NotAnonymous)
+                  (map (\y -> ( force "internal error: type" (parseTypeName (y ^?! key "type" . _String))
+                              , if y ^?! key "indexed" . _Bool
+                                then Indexed
+                                else NotIndexed ))
+                    (toList $ abi ^?! key "inputs" . _Array))
+              )
+      })
+
+signature :: AsValue s => s -> Text
+signature abi =
+  case abi ^?! key "type" of
+    "fallback" -> "<fallback>"
+    _ ->
+      fold [
+        fromMaybe "<constructor>" (abi ^? key "name" . _String), "(",
+        intercalate ","
+          (map (\x -> x ^?! key "type" . _String)
+            (toList $ abi ^?! key "inputs" . _Array)),
+        ")"
+      ]
+
+-- This actually can also parse a method output! :O
+parseMethodInput :: (Show s, AsValue s) => s -> (Text, AbiType)
+parseMethodInput x =
+  ( x ^?! key "name" . _String
+  , force "internal error: method type" (parseTypeName (x ^?! key "type" . _String))
+  )
+
+toCode :: Text -> ByteString
+toCode = fst . BS16.decode . encodeUtf8
+
+solidity' :: Text -> IO (Text, Text)
+solidity' src = withSystemTempFile "hevm.sol" $ \path handle -> do
+  hClose handle
+  writeFile path ("pragma solidity ^0.4.8;\n" <> src)
+  x <- pack <$>
+    readProcess
+      "solc"
+      ["--combined-json=bin-runtime,bin,srcmap,srcmap-runtime,abi,ast", path]
+      ""
+  return (x, pack path)
+
+-- When doing CREATE and passing constructor arguments, Solidity loads
+-- the argument data via the creation bytecode, since there is no "calldata"
+-- for CREATE.
+--
+-- This interferes with our ability to look up the current contract by
+-- codehash, so we must somehow strip away this extra suffix. Luckily
+-- we can detect the end of the actual bytecode by looking for the
+-- "metadata hash". (Not 100% correct, but works in practice.)
+--
+-- Actually, we strip away the entire BZZR suffix too, because as long
+-- as the codehash matches otherwise, we don't care if there is some
+-- difference there.
+stripBytecodeMetadata :: ByteString -> ByteString
+stripBytecodeMetadata bs =
+  let (_, b) = BS.breakSubstring bzzrPrefix (BS.reverse bs)
+  in BS.reverse b
+
+bzzrPrefix :: ByteString
+bzzrPrefix =
+  -- a1 65 "bzzr0" 0x58 0x20
+  BS.reverse $ BS.pack [0xa1, 0x65, 98, 122, 122, 114, 48, 0x58, 0x20]
+
+-- | Every node in the AST has an ID, and other nodes reference those
+-- IDs.  This function recurses through the tree looking for objects
+-- with the "id" key and makes a big map from ID to value.
+astIdMap :: Foldable f => f Value -> Map Int Value
+astIdMap = foldMap f
+  where
+    f :: Value -> Map Int Value
+    f (Array x) = foldMap f x
+    f v@(Object x) =
+      let t = foldMap f (HMap.elems x)
+      in case HMap.lookup "id" x of
+        Nothing         -> t
+        Just (Number i) -> t <> Map.singleton (round i) v
+        Just _          -> t
+    f _ = mempty
+
+astSrcMap :: Map Int Value -> (SrcMap -> Maybe Value)
+astSrcMap astIds =
+  \(SM i n f _)  -> Map.lookup (i, n, f) tmp
+  where
+    tmp :: Map (Int, Int, Int) Value
+    tmp =
+      ( Map.fromList
+      . catMaybes
+      . map (\v ->
+          case preview (key "src" . _String) v of
+            Just src ->
+              case map (readMaybe . Text.unpack) (Text.split (== ':') src) of
+                [Just i, Just n, Just f] ->
+                  Just ((i, n, f), v)
+                _ ->
+                  error "strange formatting of src field"
+            _ ->
+              Nothing)
+      . Map.elems
+      $ astIds
+      )
diff --git a/src/EVM/Stepper.hs b/src/EVM/Stepper.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Stepper.hs
@@ -0,0 +1,122 @@
+{-# Language GADTs #-}
+{-# Language NamedFieldPuns #-}
+
+module EVM.Stepper
+  ( Action (..)
+  , Failure (..)
+  , Stepper
+  , exec
+  , execFully
+  , execFullyOrFail
+  , decode
+  , fail
+  , wait
+  , evm
+  , note
+  , entering
+  , enter
+  )
+where
+
+-- This module is an abstract definition of EVM steppers.
+-- Steppers can be run as TTY debuggers or as CLI test runners.
+--
+-- The implementation uses the operational monad pattern
+-- as the framework for monadic interpretation.
+--
+-- Note: this is a sketch of a work in progress!
+
+import Prelude hiding (fail)
+
+import Control.Monad.Operational (Program, singleton)
+import Data.Binary.Get (runGetOrFail)
+import Data.Text (Text)
+
+import EVM (EVM, VMResult (VMFailure, VMSuccess), Error (Query), Query)
+import qualified EVM
+
+import EVM.ABI (AbiType, AbiValue, getAbi)
+import EVM.Concrete (Blob (B))
+
+import qualified Data.ByteString.Lazy as LazyByteString
+
+-- | The instruction type of the operational monad
+data Action a where
+
+  -- | Keep executing until an intermediate result is reached
+  Exec ::            Action VMResult
+  
+  -- | Short-circuit with a failure
+  Fail :: Failure -> Action a
+  
+  -- | Wait for a query to be resolved
+  Wait :: Query   -> Action ()
+
+  -- | Embed a VM state transformation
+  EVM  :: EVM a   -> Action a
+
+  -- | Write something to the log or terminal
+  Note :: Text    -> Action ()
+
+-- | Some failure raised by a stepper
+data Failure
+  = ContractNotFound
+  | DecodingError
+  | VMFailed Error
+  deriving Show
+
+-- | Type alias for an operational monad of @Action@
+type Stepper a = Program Action a
+
+-- Singleton actions
+
+exec :: Stepper VMResult
+exec = singleton Exec
+
+fail :: Failure -> Stepper a
+fail = singleton . Fail
+
+wait :: Query -> Stepper ()
+wait = singleton . Wait
+
+evm :: EVM a -> Stepper a
+evm = singleton . EVM
+
+note :: Text -> Stepper ()
+note = singleton . Note
+
+-- | Run the VM until final result, resolving all queries
+execFully :: Stepper (Either Error Blob)
+execFully =
+  exec >>= \case
+    VMFailure (Query q) ->
+      wait q >> execFully
+    VMFailure x ->
+      pure (Left x)
+    VMSuccess x ->
+      pure (Right x)
+
+execFullyOrFail :: Stepper Blob
+execFullyOrFail = execFully >>= either (fail . VMFailed) pure
+
+-- | Decode a blob as an ABI value, failing if ABI encoding wrong
+decode :: AbiType -> Blob -> Stepper AbiValue
+decode abiType (B bytes) =
+  case runGetOrFail (getAbi abiType) (LazyByteString.fromStrict bytes) of
+    Right ("", _, x) ->
+      pure x
+    Right _ ->
+      fail DecodingError
+    Left _ ->
+      fail DecodingError
+
+entering :: Text -> Stepper a -> Stepper a
+entering t stepper = do
+  evm (EVM.pushTrace (EVM.EntryTrace t))
+  x <- stepper
+  evm EVM.popTrace
+  pure x
+
+enter :: Text -> Stepper ()
+enter t = do
+  evm (EVM.pushTrace (EVM.EntryTrace t))
diff --git a/src/EVM/StorageLayout.hs b/src/EVM/StorageLayout.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/StorageLayout.hs
@@ -0,0 +1,185 @@
+module EVM.StorageLayout where
+
+-- Figures out the layout of storage slots for Solidity contracts.
+
+import EVM.Dapp (DappInfo, dappAstSrcMap, dappAstIdMap)
+import EVM.Solidity (SolcContract, creationSrcmap)
+import EVM.ABI (AbiType (..), parseTypeName, abiTypeSolidity)
+
+import Data.Aeson (Value (Number))
+import Data.Aeson.Lens
+
+import Control.Lens
+
+import Data.Text (Text, unpack, words)
+
+import Data.Foldable (toList)
+import Data.Maybe (fromMaybe, isJust)
+import Data.Monoid ((<>))
+
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
+
+import qualified Data.Sequence as Seq
+
+import Prelude hiding (words)
+
+-- A contract has all the slots of its inherited contracts.
+--
+-- The slot order is determined by the inheritance linearization order,
+-- so we first have to calculate that.
+--
+-- This information is available in the abstract syntax tree.
+
+findContractDefinition :: DappInfo -> SolcContract -> Maybe Value
+findContractDefinition dapp solc =
+  -- The first source mapping in the contract's creation code
+  -- corresponds to the source field of the contract definition.
+  case Seq.viewl (view creationSrcmap solc) of
+    firstSrcMap Seq.:< _ ->
+      (view dappAstSrcMap dapp) firstSrcMap
+    _ ->
+      Nothing
+
+storageLayout :: DappInfo -> SolcContract -> [Text]
+storageLayout dapp solc =
+  let
+    root :: Value
+    root =
+      fromMaybe (error "no contract definition AST")
+        (findContractDefinition dapp solc)
+  in
+    case preview ( key "attributes"
+                 . key "linearizedBaseContracts"
+                 . _Array
+                 ) root of
+      Nothing ->
+        []
+      Just ((reverse . toList) -> linearizedBaseContracts) ->
+        flip concatMap linearizedBaseContracts
+          (\case
+             Number i -> fromMaybe (error "malformed AST JSON") $
+               storageVariablesForContract =<<
+                 preview (dappAstIdMap . ix (floor i)) dapp
+             _ ->
+               error "malformed AST JSON")
+
+storageVariablesForContract :: Value -> Maybe [Text]
+storageVariablesForContract node = do
+  name <- preview (ix "attributes" . key "name" . _String) node
+  vars <-
+    fmap
+      (filter isStorageVariableDeclaration . toList)
+      (preview (ix "children" . _Array) node)
+
+  pure . flip map vars $
+    \x ->
+      case preview (key "attributes" . key "name" . _String) x of
+        Just variableName ->
+          mconcat
+            [ variableName
+            , " (", name, ")"
+            , "\n", "  Type: "
+            , slotTypeSolidity (slotTypeForDeclaration x)
+            ]
+        Nothing ->
+          error "malformed variable declaration"
+
+nodeIs :: Text -> Value -> Bool
+nodeIs t x = isSourceNode && hasRightName
+  where
+    isSourceNode =
+      isJust (preview (key "src") x)
+    hasRightName =
+      Just t == preview (key "name" . _String) x
+
+isStorageVariableDeclaration :: Value -> Bool
+isStorageVariableDeclaration x =
+  nodeIs "VariableDeclaration" x
+    && preview (key "attributes" . key "constant" . _Bool) x /= Just True
+
+data SlotType
+  -- Note that mapping keys can only be elementary;
+  -- that excludes arrays, contracts, and mappings.
+  = StorageMapping (NonEmpty AbiType) AbiType
+  | StorageValue AbiType
+  deriving Show
+
+slotTypeSolidity :: SlotType -> Text
+slotTypeSolidity =
+  \case
+    StorageValue t ->
+      abiTypeSolidity t
+    StorageMapping (s NonEmpty.:| ss) t ->
+      "mapping("
+        <> abiTypeSolidity s
+        <> " => "
+        <> foldr
+             (\x y ->
+               "mapping("
+                 <> abiTypeSolidity x
+                 <> " => "
+                 <> y
+                 <> ")")
+             (abiTypeSolidity t) ss
+        <> ")"
+
+slotTypeForDeclaration :: Value -> SlotType
+slotTypeForDeclaration node =
+  case toList <$> preview (key "children" . _Array) node of
+    Just (x:_) ->
+      grokDeclarationType x
+    _ ->
+      error "malformed AST"
+
+grokDeclarationType :: Value -> SlotType
+grokDeclarationType x =
+  case preview (key "name" . _String) x of
+    Just "Mapping" ->
+      case preview (key "children" . _Array) x of
+        Just (toList -> xs) ->
+          grokMappingType xs
+        _ ->
+          error "malformed AST"
+    Just _ ->
+      StorageValue (grokValueType x)
+    _ ->
+      error ("malformed AST " ++ show x)
+
+grokMappingType :: [Value] -> SlotType
+grokMappingType [s, t] =
+  case (grokDeclarationType s, grokDeclarationType t) of
+    (StorageValue s', StorageMapping t' x) ->
+      StorageMapping (NonEmpty.cons s' t') x
+    (StorageValue s', StorageValue t') ->
+      StorageMapping (pure s') t'
+    (StorageMapping _ _, _) ->
+      error "unexpected mapping as mapping key"
+grokMappingType _ =
+  error "unexpected AST child count for mapping"
+
+grokValueType :: Value -> AbiType
+grokValueType x =
+  case ( preview (key "name" . _String) x
+       , preview (key "children" . _Array) x
+       , preview (key "attributes" . key "type" . _String) x
+       ) of
+    (Just "ElementaryTypeName", _, Just typeName) ->
+      case parseTypeName (head (words typeName)) of
+        Just t -> t
+        Nothing ->
+          error ("ungrokked value type: " ++ show typeName)
+    (Just "UserDefinedTypeName", _, _) ->
+      AbiAddressType
+    (Just "ArrayTypeName", fmap toList -> Just [t], _)->
+      AbiArrayDynamicType (grokValueType t)
+    (Just "ArrayTypeName", fmap toList -> Just [t, n], _)->
+      case ( preview (key "name" . _String) n
+           , preview (key "attributes" . key "value" . _String) n
+           ) of
+        (Just "Literal", Just ((read . unpack) -> i)) ->
+          AbiArrayType i (grokValueType t)
+        _ ->
+          error "malformed AST"
+    _ ->
+      error ("unknown value type " ++ show x)
diff --git a/src/EVM/TTY.hs b/src/EVM/TTY.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/TTY.hs
@@ -0,0 +1,894 @@
+{-# Language TemplateHaskell #-}
+{-# Language ImplicitParams #-}
+
+module EVM.TTY where
+
+import Prelude hiding (Word)
+
+import Brick
+import Brick.Widgets.Border
+import Brick.Widgets.Center
+import Brick.Widgets.List
+
+import EVM
+import EVM.Concrete (Word (C))
+import EVM.Dapp (DappInfo, dappInfo)
+import EVM.Dapp (dappUnitTests, dappSolcByName, dappSolcByHash, dappSources)
+import EVM.Dapp (dappAstSrcMap)
+import EVM.Debug
+import EVM.Format (Signedness (..), showDec, showWordExact)
+import EVM.Format (showTraceTree)
+import EVM.Format (contractNamePart, contractPathPart)
+import EVM.Op
+import EVM.Solidity
+import EVM.Types hiding (padRight)
+import EVM.UnitTest (UnitTestOptions (..))
+import EVM.UnitTest (initialUnitTestVm)
+import EVM.UnitTest (initializeUnitTest, runUnitTest)
+import EVM.StorageLayout
+
+import EVM.Stepper (Stepper)
+import qualified EVM.Stepper as Stepper
+import qualified Control.Monad.Operational as Operational
+
+import EVM.Fetch (Fetcher)
+import qualified EVM.Fetch as Fetch
+
+import Control.Lens
+import Control.Monad.State.Strict hiding (state)
+
+import Data.Aeson.Lens
+import Data.ByteString (ByteString)
+import Data.Maybe (fromJust, fromMaybe)
+import Data.Monoid ((<>))
+import Data.Text (Text, unpack, pack)
+import Data.Text.Encoding (decodeUtf8)
+import Data.List (sort)
+import Numeric (showHex)
+
+import qualified Data.ByteString as BS
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import qualified Data.Vector as Vec
+import qualified Data.Vector.Storable as SVec
+import qualified Graphics.Vty as Vty
+import qualified System.Console.Haskeline as Readline
+
+import qualified EVM.TTYCenteredList as Centered
+
+data Name
+  = AbiPane
+  | StackPane
+  | BytecodePane
+  | TracePane
+  | SolidityPane
+  | SolidityViewport
+  | TestPickerPane
+  | BrowserPane
+  deriving (Eq, Show, Ord)
+
+type UiWidget = Widget Name
+
+data UiVmState = UiVmState
+  { _uiVm             :: VM
+  , _uiVmNextStep     :: Stepper ()
+  , _uiVmStackList    :: List Name (Int, Word)
+  , _uiVmBytecodeList :: List Name (Int, Op)
+  , _uiVmTraceList    :: List Name Text
+  , _uiVmSolidityList :: List Name (Int, ByteString)
+  , _uiVmSolc         :: Maybe SolcContract
+  , _uiVmDapp         :: Maybe DappInfo
+  , _uiVmStepCount    :: Int
+  , _uiVmFirstState   :: UiVmState
+  , _uiVmMessage      :: Maybe String
+  , _uiVmNotes        :: [String]
+  }
+
+data UiTestPickerState = UiTestPickerState
+  { _testPickerList :: List Name (Text, Text)
+  , _testPickerDapp :: DappInfo
+  }
+
+data UiBrowserState = UiBrowserState
+  { _browserContractList :: List Name (Addr, Contract)
+  , _browserVm :: UiVmState
+  }
+
+data UiState
+  = UiVmScreen UiVmState
+  | UiVmBrowserScreen UiBrowserState
+  | UiTestPickerScreen UiTestPickerState
+
+makeLenses ''UiVmState
+makeLenses ''UiTestPickerState
+makeLenses ''UiBrowserState
+makePrisms ''UiState
+
+type Pred a = a -> Bool
+
+data StepMode
+  = StepOne                        -- ^ Finish after one opcode step
+  | StepMany !Int                  -- ^ Run a specific number of steps
+  | StepNone                       -- ^ Finish before the next opcode
+  | StepUntil (Pred VM)            -- ^ Finish when a VM predicate holds
+
+-- | Each step command in the terminal should finish immediately
+-- with one of these outcomes.
+data StepOutcome a
+  = Returned a                -- ^ Program finished
+  | Stepped  (Stepper a)      -- ^ Took one step; more steps to go
+  | Blocked  (IO (Stepper a)) -- ^ Came across blocking request
+
+-- | This turns a @Stepper@ into a state action usable
+-- from within the TTY loop, yielding a @StepOutcome@ depending on the @StepMode@.
+interpret
+  :: (?fetcher :: Fetcher)
+  => StepMode
+  -> Stepper a
+  -> State UiVmState (StepOutcome a)
+interpret mode =
+
+  -- Like the similar interpreters in @EVM.UnitTest@ and @EVM.VMTest@,
+  -- this one is implemented as an "operational monad interpreter".
+
+  eval . Operational.view
+  where
+    eval
+      :: Operational.ProgramView Stepper.Action a
+      -> State UiVmState (StepOutcome a)
+
+    eval (Operational.Return x) =
+      pure (Returned x)
+
+    eval (action Operational.:>>= k) =
+      case action of
+
+        -- Stepper wants to keep executing?
+        Stepper.Exec -> do
+
+          let
+            -- When pausing during exec, we should later restart
+            -- the exec with the same continuation.
+            restart = Stepper.exec >>= k
+
+          case mode of
+            StepNone ->
+              -- We come here when we've continued while stepping,
+              -- either from a query or from a return;
+              -- we should pause here and wait for the user.
+              pure (Stepped (Operational.singleton action >>= k))
+
+            StepOne -> do
+              -- Run an instruction
+              modify stepOneOpcode
+
+              use (uiVm . result) >>= \case
+                Nothing ->
+                  -- If instructions remain, then pause & await user.
+                  pure (Stepped restart)
+                Just r ->
+                  -- If returning, proceed directly the continuation,
+                  -- but stopping before the next instruction.
+                  interpret StepNone (k r)
+
+            StepMany 0 -> do
+              -- Finish the continuation until the next instruction;
+              -- then, pause & await user.
+              interpret StepNone restart
+
+            StepMany i -> do
+              -- Run one instruction.
+              interpret StepOne restart >>=
+                \case
+                  Stepped stepper ->
+                    interpret (StepMany (i - 1)) stepper
+
+                  -- This shouldn't happen, because re-stepping needs
+                  -- to avoid blocking and halting.
+                  r -> pure r
+
+            StepUntil p -> do
+              vm <- use uiVm
+              case p vm of
+                True ->
+                  interpret StepNone restart
+                False ->
+                  interpret StepOne restart >>=
+                    \case
+                      Stepped stepper ->
+                        interpret (StepUntil p) stepper
+
+                      -- This means that if we hit a blocking query
+                      -- or a return, we pause despite the predicate.
+                      --
+                      -- This could be fixed if we allowed query I/O
+                      -- here, instead of only in the TTY event loop;
+                      -- let's do it later.
+                      r -> pure r
+
+        -- Stepper wants to make a query and wait for the results?
+        Stepper.Wait q -> do
+          -- Tell the TTY to run an I/O action to produce the next stepper.
+          pure . Blocked $ do
+            -- First run the fetcher, getting a VM state transition back.
+            m <- ?fetcher q
+            -- Join that transition with the stepper script's continuation.
+            pure (Stepper.evm m >> k ())
+
+        -- Stepper wants to modify the VM.
+        Stepper.EVM m -> do
+          vm0 <- use uiVm
+          let (r, vm1) = runState m vm0
+          modify (flip updateUiVmState vm1)
+          interpret mode (k r)
+
+        -- Stepper wants to emit a message.
+        Stepper.Note s -> do
+          assign uiVmMessage (Just (unpack s))
+          modifying uiVmNotes (unpack s :)
+          interpret mode (k ())
+
+        -- Stepper wants to exit because of a failure.
+        Stepper.Fail e ->
+          error ("VM error: " ++ show e)
+
+isUnitTestContract :: Text -> DappInfo -> Bool
+isUnitTestContract name dapp =
+  elem name (map fst (view dappUnitTests dapp))
+
+mkVty :: IO Vty.Vty
+mkVty = do
+  vty <- Vty.mkVty Vty.defaultConfig
+  Vty.setMode (Vty.outputIface vty) Vty.BracketedPaste True
+  return vty
+
+runFromVM :: VM -> IO VM
+runFromVM vm = do
+  let
+    ui0 = UiVmState
+           { _uiVm = vm
+           , _uiVmNextStep =
+               void Stepper.execFully >> Stepper.evm finalize
+           , _uiVmStackList = undefined
+           , _uiVmBytecodeList = undefined
+           , _uiVmTraceList = undefined
+           , _uiVmSolidityList = undefined
+           , _uiVmSolc = Nothing
+           , _uiVmDapp = Nothing
+           , _uiVmStepCount = 0
+           , _uiVmFirstState = undefined
+           , _uiVmMessage = Just "Executing EVM code"
+           , _uiVmNotes = []
+           }
+    ui1 = updateUiVmState ui0 vm & set uiVmFirstState ui1
+
+    testOpts = UnitTestOptions
+      { oracle            = Fetch.zero
+      , verbose           = False
+      , match             = ""
+      , vmModifier        = id
+      , testParams        = error "irrelevant"
+      }
+
+  ui2 <- customMain mkVty Nothing (app testOpts) (UiVmScreen ui1)
+  case ui2 of
+    UiVmScreen ui -> return (view uiVm ui)
+    _ -> error "internal error: customMain returned prematurely"
+
+main :: UnitTestOptions -> FilePath -> FilePath -> IO ()
+main opts root jsonFilePath = do
+  readSolc jsonFilePath >>=
+    \case
+      Nothing ->
+        error "Failed to read Solidity JSON"
+      Just (contractMap, sourceCache) -> do
+        let
+          dapp = dappInfo root contractMap sourceCache
+          ui = UiTestPickerScreen $ UiTestPickerState
+            { _testPickerList =
+                list
+                  TestPickerPane
+                  (Vec.fromList
+                   (concatMap
+                    (\(a, xs) -> [(a, x) | x <- xs])
+                    (view dappUnitTests dapp)))
+                  1
+            , _testPickerDapp = dapp
+            }
+
+        _ <- customMain mkVty Nothing (app opts) (ui :: UiState)
+        return ()
+
+-- ^ Specifies whether to do I/O blocking or VM halting while stepping.
+-- When we step backwards, we don't want to allow those things.
+data StepPolicy
+  = StepNormally    -- ^ Allow blocking and returning
+  | StepTimidly     -- ^ Forbid blocking and returning
+
+takeStep
+  :: (?fetcher :: Fetcher)
+  => UiVmState
+  -> StepPolicy
+  -> StepMode
+  -> EventM n (Next UiState)
+takeStep ui policy mode = do
+  let m = interpret mode (view uiVmNextStep ui)
+
+  case runState (m <* modify renderVm) ui of
+
+    (Stepped stepper, ui') -> do
+      continue (UiVmScreen (ui' & set uiVmNextStep stepper))
+
+    (Blocked blocker, ui') ->
+      case policy of
+        StepNormally -> do
+          stepper <- liftIO blocker
+          takeStep
+            (execState (assign uiVmNextStep stepper) ui')
+            StepNormally StepNone
+
+        StepTimidly ->
+          error "step blocked unexpectedly"
+
+    (Returned (), ui') ->
+      case policy of
+        StepNormally ->
+          halt (UiVmScreen ui')
+        StepTimidly ->
+          error "step halted unexpectedly"
+
+app :: UnitTestOptions -> App UiState () Name
+app opts =
+  let ?fetcher = oracle opts
+  in App
+  { appDraw = drawUi
+  , appChooseCursor = neverShowCursor
+  , appHandleEvent = \ui e ->
+
+      case (ui, e) of
+        (UiVmBrowserScreen s, VtyEvent (Vty.EvKey Vty.KEsc [])) ->
+          continue (UiVmScreen (view browserVm s))
+
+        (UiVmBrowserScreen s, VtyEvent e'@(Vty.EvKey Vty.KDown [])) -> do
+          s' <- handleEventLensed s
+            browserContractList
+            handleListEvent
+            e'
+          continue (UiVmBrowserScreen s')
+
+        (UiVmBrowserScreen s, VtyEvent e'@(Vty.EvKey Vty.KUp [])) -> do
+          s' <- handleEventLensed s
+            browserContractList
+            handleListEvent
+            e'
+          continue (UiVmBrowserScreen s')
+
+        (_, VtyEvent (Vty.EvKey Vty.KEsc [])) ->
+          halt ui
+
+        (UiVmScreen s, VtyEvent (Vty.EvKey Vty.KEnter [])) ->
+            continue . UiVmBrowserScreen $ UiBrowserState
+              { _browserContractList =
+                  list
+                    BrowserPane
+                    (Vec.fromList (Map.toList (view (uiVm . env . contracts) s)))
+                    2
+              , _browserVm = s
+              }
+
+        (UiVmScreen s, VtyEvent (Vty.EvKey (Vty.KChar ' ') [])) ->
+          let
+            loop = do
+              Just hey <- Readline.getInputLine "% "
+              Readline.outputStrLn hey
+              Just hey' <- Readline.getInputLine "% "
+              Readline.outputStrLn hey'
+              return (UiVmScreen s)
+          in
+            suspendAndResume $
+              Readline.runInputT Readline.defaultSettings loop
+
+
+        (UiVmScreen s, VtyEvent (Vty.EvKey (Vty.KChar 'n') [])) ->
+          takeStep s StepNormally StepOne
+
+        (UiVmScreen s, VtyEvent (Vty.EvKey (Vty.KChar 'N') [])) ->
+          takeStep s
+            StepNormally
+            (StepUntil (isNextSourcePosition s))
+
+        (UiVmScreen s, VtyEvent (Vty.EvKey (Vty.KChar 'n') [Vty.MCtrl])) ->
+          takeStep s
+            StepNormally
+            (StepUntil (isNextSourcePositionWithoutEntering s))
+
+        (UiVmScreen s, VtyEvent (Vty.EvKey (Vty.KChar 'p') [])) ->
+          case view uiVmStepCount s of
+            0 ->
+              -- We're already at the first step; ignore command.
+              continue ui
+
+            n -> do
+              -- To step backwards, we revert to the first state
+              -- and execute n - 1 instructions from there.
+              --
+              -- We keep the current cache so we don't have to redo
+              -- any blocking queries.
+              let
+                s0 = view uiVmFirstState s
+                s1 = set (uiVm . cache) (view (uiVm . cache) s) s0
+
+              -- Take n steps; "timidly," because all queries
+              -- ought to be cached.
+              takeStep s1 StepTimidly (StepMany (n - 1))
+
+        (UiTestPickerScreen s', VtyEvent (Vty.EvKey (Vty.KEnter) [])) -> do
+          case listSelectedElement (view testPickerList s') of
+            Nothing -> error "nothing selected"
+            Just (_, x) ->
+              continue . UiVmScreen $
+                initialUiVmStateForTest opts (view testPickerDapp s') x
+
+        (UiTestPickerScreen s', VtyEvent e') -> do
+          s'' <- handleEventLensed s'
+            testPickerList
+            handleListEvent
+            e'
+          continue (UiTestPickerScreen s'')
+
+        _ ->
+          continue ui
+
+  , appStartEvent = return
+  , appAttrMap = const (attrMap Vty.defAttr myTheme)
+  }
+
+initialUiVmStateForTest
+  :: UnitTestOptions
+  -> DappInfo
+  -> (Text, Text)
+  -> UiVmState
+initialUiVmStateForTest opts@(UnitTestOptions {..}) dapp (theContractName, theTestName) =
+  ui1
+  where
+    script = do
+      Stepper.evm . pushTrace . EntryTrace $
+        "test " <> theTestName <> " (" <> theContractName <> ")"
+      initializeUnitTest opts
+      void (runUnitTest opts theTestName)
+    ui0 =
+      UiVmState
+        { _uiVm             = vm0
+        , _uiVmNextStep     = script
+        , _uiVmStackList    = undefined
+        , _uiVmBytecodeList = undefined
+        , _uiVmTraceList    = undefined
+        , _uiVmSolidityList = undefined
+        , _uiVmSolc         = Just testContract
+        , _uiVmDapp         = Just dapp
+        , _uiVmStepCount    = 0
+        , _uiVmFirstState   = undefined
+        , _uiVmMessage      = Just "Creating unit test contract"
+        , _uiVmNotes        = []
+        }
+    Just testContract =
+      view (dappSolcByName . at theContractName) dapp
+    vm0 =
+      initialUnitTestVm opts testContract (Map.elems (view dappSolcByName dapp))
+    ui1 =
+      updateUiVmState ui0 vm0 & set uiVmFirstState ui1
+
+myTheme :: [(AttrName, Vty.Attr)]
+myTheme =
+  [ (selectedAttr, Vty.defAttr `Vty.withStyle` Vty.standout)
+  , (dimAttr, Vty.defAttr `Vty.withStyle` Vty.dim)
+  , (borderAttr, Vty.defAttr `Vty.withStyle` Vty.dim)
+  , (wordAttr, fg Vty.yellow)
+  , (boldAttr, Vty.defAttr `Vty.withStyle` Vty.bold)
+  , (activeAttr, Vty.defAttr `Vty.withStyle` Vty.standout)
+  ]
+
+drawUi :: UiState -> [UiWidget]
+drawUi (UiVmScreen s) = drawVm s
+drawUi (UiTestPickerScreen s) = drawTestPicker s
+drawUi (UiVmBrowserScreen s) = drawVmBrowser s
+
+drawTestPicker :: UiTestPickerState -> [UiWidget]
+drawTestPicker ui =
+  [ center . borderWithLabel (txt "Unit tests") .
+      hLimit 80 $
+        renderList
+          (\selected (x, y) ->
+             withHighlight selected $
+               txt " Debug " <+> txt (contractNamePart x) <+> txt "::" <+> txt y)
+          True
+          (view testPickerList ui)
+  ]
+
+drawVmBrowser :: UiBrowserState -> [UiWidget]
+drawVmBrowser ui =
+  [ hBox
+      [ borderWithLabel (txt "Contracts") .
+          hLimit 60 $
+            renderList
+              (\selected (k, c) ->
+                 withHighlight selected . txt . mconcat $
+                   [ fromMaybe "<unknown contract>" . flip preview ui $
+                       ( browserVm . uiVmDapp . _Just . dappSolcByHash . ix (view codehash c)
+                       . _2 . contractName )
+                   , "\n"
+                   , "  ", pack (show k)
+                   ])
+              True
+              (view browserContractList ui)
+      , let
+          Just (_, (_, c)) = listSelectedElement (view browserContractList ui)
+          Just dapp = view (browserVm . uiVmDapp) ui
+        in case flip preview ui (browserVm . uiVmDapp . _Just . dappSolcByHash . ix (view codehash c) . _2) of
+          Nothing -> txt ("n/a; codehash " <> pack (show (view codehash c)))
+          Just solc ->
+            hBox
+              [ borderWithLabel (txt "Contract information") . padBottom Max . padRight (Pad 2) $ vBox
+                  [ txt "Name: " <+> txt (contractNamePart (view contractName solc))
+                  , txt "File: " <+> txt (contractPathPart (view contractName solc))
+                    , txt " "
+                    , txt "Public methods:"
+                    , vBox . flip map (sort (Map.elems (view abiMap solc))) $
+                        \method -> txt ("  " <> view methodSignature method)
+                    ]
+                , borderWithLabel (txt "Storage slots") . padBottom Max . padRight Max $ vBox
+                    (map txt (storageLayout dapp solc))
+                ]
+      ]
+  ]
+
+drawVm :: UiVmState -> [UiWidget]
+drawVm ui =
+  -- EVM debugging needs a lot of space because of the 256-bit words
+  -- in both the bytecode and the stack .
+  --
+  -- If on a very tall display, prefer a vertical layout.
+  --
+  -- Actually the horizontal layout would be preferrable if the display
+  -- is both very tall and very wide, but this is okay for now.
+  [ ifTallEnough (20 * 4)
+      ( vBox
+        [ vLimit 20 $ drawBytecodePane ui
+        , vLimit 20 $ drawStackPane ui
+        , drawSolidityPane ui
+        , vLimit 20 $ drawTracePane ui
+        , vLimit 2 $ drawHelpBar
+        ]
+      )
+      ( vBox
+        [ hBox
+          [ vLimit 20 $ drawBytecodePane ui
+          , vLimit 20 $ drawStackPane ui
+          ]
+        , hBox $
+          [ drawSolidityPane ui
+          , drawTracePane ui
+          ]
+        , vLimit 2 $ drawHelpBar
+        ]
+      )
+  ]
+
+drawHelpBar :: UiWidget
+drawHelpBar = hBorder <=> hCenter help
+  where
+    help =
+      hBox (map (\(k, v) -> txt k <+> dim (txt (" (" <> v <> ")  "))) helps)
+
+    helps =
+      [
+        ("n", "step")
+      , ("p", "step back")
+      , ("N", "step more")
+      , ("C-n", "step over")
+--      , ("  Enter", "browse")
+      , ("  Esc", "exit")
+      ]
+
+stepOneOpcode :: UiVmState -> UiVmState
+stepOneOpcode ui =
+  let
+    nextVm = execState exec1 (view uiVm ui)
+  in
+    ui & over uiVmStepCount (+ 1)
+       & set uiVm nextVm
+
+isNextSourcePosition
+  :: UiVmState -> Pred VM
+isNextSourcePosition ui vm =
+  let
+    Just dapp       = view uiVmDapp ui
+    initialPosition = currentSrcMap dapp (view uiVm ui)
+  in
+    currentSrcMap dapp vm /= initialPosition
+
+isNextSourcePositionWithoutEntering
+  :: UiVmState -> Pred VM
+isNextSourcePositionWithoutEntering ui vm =
+  let
+    vm0             = view uiVm ui
+    Just dapp       = view uiVmDapp ui
+    initialPosition = currentSrcMap dapp vm0
+    initialHeight   = length (view frames vm0)
+  in
+    case currentSrcMap dapp vm of
+      Nothing ->
+        True
+      Just here ->
+        let
+          moved = Just here /= initialPosition
+          deeper = length (view frames vm) > initialHeight
+          boring =
+            case srcMapCode (view dappSources dapp) here of
+              Just bs ->
+                BS.isPrefixOf "contract " bs
+              Nothing ->
+                True
+        in
+           moved && not deeper && not boring
+
+currentSrcMap :: DappInfo -> VM -> Maybe SrcMap
+currentSrcMap dapp vm =
+  let
+    this = vm ^?! env . contracts . ix (view (state . codeContract) vm)
+    i = (view opIxMap this) SVec.! (view (state . pc) vm)
+    h = view codehash this
+  in
+    case preview (dappSolcByHash . ix h) dapp of
+      Nothing ->
+        Nothing
+      Just (Creation, solc) ->
+        preview (creationSrcmap . ix i) solc
+      Just (Runtime, solc) ->
+        preview (runtimeSrcmap . ix i) solc
+
+currentSolc :: DappInfo -> VM -> Maybe SolcContract
+currentSolc dapp vm =
+  let
+    this = vm ^?! env . contracts . ix (view (state . contract) vm)
+    h = view codehash this
+  in
+    preview (dappSolcByHash . ix h . _2) dapp
+
+renderVm :: UiVmState -> UiVmState
+renderVm ui = updateUiVmState ui (view uiVm ui)
+
+updateUiVmState :: UiVmState -> VM -> UiVmState
+updateUiVmState ui vm =
+  let
+    move = case vmOpIx vm of
+             Nothing -> id
+             Just x -> listMoveTo x
+    ui' = ui
+      & set uiVm vm
+      & set uiVmStackList
+          (list StackPane (Vec.fromList $ zip [1..] (view (state . stack) vm)) 2)
+      & set uiVmBytecodeList
+          (move $ list BytecodePane
+             (view codeOps (fromJust (currentContract vm)))
+             1)
+  in
+    case view uiVmDapp ui of
+      Nothing ->
+        ui'
+          & set uiVmTraceList (list TracePane mempty 1)
+          & set uiVmSolidityList (list SolidityPane mempty 1)
+      Just dapp ->
+        ui'
+          & set uiVmTraceList
+              (list
+                TracePane
+                (Vec.fromList
+                 . Text.lines
+                 . showTraceTree dapp
+                 $ vm)
+                1)
+          & set uiVmSolidityList
+              (list SolidityPane
+                 (case currentSrcMap dapp vm of
+                    Nothing -> mempty
+                    Just x ->
+                      view (dappSources
+                            . sourceLines
+                            . ix (srcMapFile x)
+                            . to (Vec.imap (,)))
+                        dapp)
+                 1)
+
+drawStackPane :: UiVmState -> UiWidget
+drawStackPane ui =
+  let
+    gasText = showWordExact (view (uiVm . state . gas) ui)
+    labelText = txt ("Gas available: " <> gasText <> "; stack:")
+  in hBorderWithLabel labelText <=>
+    renderList
+      (\_ (i, x@(C _ w)) ->
+         vBox
+           [ withHighlight True (str ("#" ++ show i ++ " "))
+               <+> str (show x)
+           , dim (txt ("   " <> showWordExplanation w (view uiVmDapp ui)))
+           ])
+      False
+      (view uiVmStackList ui)
+
+showWordExplanation :: W256 -> Maybe DappInfo -> Text
+showWordExplanation w Nothing = showDec Unsigned w
+showWordExplanation w _ | w > 0xffffffff = showDec Unsigned w
+showWordExplanation w (Just dapp) =
+  let
+    fullAbiMap =
+      mconcat (map (view abiMap) (Map.elems (view dappSolcByName dapp)))
+  in
+    case Map.lookup (fromIntegral w) fullAbiMap of
+      Nothing -> showDec Unsigned w
+      Just x  -> "keccak(\"" <> view methodSignature x <> "\")"
+
+drawBytecodePane :: UiVmState -> UiWidget
+drawBytecodePane ui =
+  hBorderWithLabel (case view uiVmMessage ui of { Nothing -> str ""; Just s -> str s }) <=>
+    Centered.renderList
+      (\active x -> if not active
+                    then withDefAttr dimAttr (opWidget x)
+                    else withDefAttr boldAttr (opWidget x))
+      False
+      (view uiVmBytecodeList ui)
+
+dim :: Widget n -> Widget n
+dim = withDefAttr dimAttr
+
+withHighlight :: Bool -> Widget n -> Widget n
+withHighlight False = withDefAttr dimAttr
+withHighlight True  = withDefAttr boldAttr
+
+drawTracePane :: UiVmState -> UiWidget
+drawTracePane ui =
+  hBorderWithLabel (txt "Trace") <=>
+    renderList
+      (\_ x -> txt x)
+      False
+      (view uiVmTraceList ui)
+
+drawSolidityPane :: UiVmState -> UiWidget
+drawSolidityPane ui@(view uiVmDapp -> Just dapp) =
+  case currentSrcMap dapp (view uiVm ui) of
+    Nothing -> padBottom Max (hBorderWithLabel (txt "<no source map>"))
+    Just sm ->
+      case view (dappSources . sourceLines . at (srcMapFile sm)) dapp of
+        Nothing -> padBottom Max (hBorderWithLabel (txt "<source not found>"))
+        Just rows ->
+          let
+            subrange i = lineSubrange rows (srcMapOffset sm, srcMapLength sm) i
+            lineNo =
+              (snd . fromJust $
+                (srcMapCodePos
+                 (view dappSources dapp)
+                 sm)) - 1
+          in vBox
+            [ hBorderWithLabel $
+                txt (maybe "<unknown>" contractPathPart
+                      (preview (uiVmSolc . _Just . contractName) ui))
+                  <+> str (":" ++ show lineNo)
+
+                  -- Show the AST node type if present
+                  <+> txt (" (" <> fromMaybe "?"
+                                    ((view dappAstSrcMap dapp) sm
+                                       >>= preview (key "name" . _String)) <> ")")
+            , Centered.renderList
+                (\_ (i, line) ->
+                   let s = case decodeUtf8 line of "" -> " "; y -> y
+                   in case subrange i of
+                        Nothing -> withHighlight False (txt s)
+                        Just (a, b) ->
+                          let (x, y, z) = ( Text.take a s
+                                          , Text.take b (Text.drop a s)
+                                          , Text.drop (a + b) s
+                                          )
+                          in hBox [ withHighlight False (txt x)
+                                  , withHighlight True (txt y)
+                                  , withHighlight False (txt z)
+                                  ])
+                False
+                (listMoveTo lineNo
+                  (view uiVmSolidityList ui))
+            ]
+drawSolidityPane _ =
+  -- When e.g. debugging raw EVM code without dapp info,
+  -- don't show a Solidity pane.
+  vBox []
+
+ifTallEnough :: Int -> Widget n -> Widget n -> Widget n
+ifTallEnough need w1 w2 =
+  Widget Greedy Greedy $ do
+    c <- getContext
+    if view availHeightL c > need
+      then render w1
+      else render w2
+
+showPc :: (Integral a, Show a) => a -> String
+showPc x =
+  if x < 0x10
+  then '0' : showHex x ""
+  else showHex x ""
+
+opWidget :: (Integral a, Show a) => (a, Op) -> Widget n
+opWidget (i, o) = str (showPc i <> " ") <+> case o of
+  OpStop -> txt "STOP"
+  OpAdd -> txt "ADD"
+  OpMul -> txt "MUL"
+  OpSub -> txt "SUB"
+  OpDiv -> txt "DIV"
+  OpSdiv -> txt "SDIV"
+  OpMod -> txt "MOD"
+  OpSmod -> txt "SMOD"
+  OpAddmod -> txt "ADDMOD"
+  OpMulmod -> txt "MULMOD"
+  OpExp -> txt "EXP"
+  OpSignextend -> txt "SIGNEXTEND"
+  OpLt -> txt "LT"
+  OpGt -> txt "GT"
+  OpSlt -> txt "SLT"
+  OpSgt -> txt "SGT"
+  OpEq -> txt "EQ"
+  OpIszero -> txt "ISZERO"
+  OpAnd -> txt "AND"
+  OpOr -> txt "OR"
+  OpXor -> txt "XOR"
+  OpNot -> txt "NOT"
+  OpByte -> txt "BYTE"
+  OpSha3 -> txt "SHA3"
+  OpAddress -> txt "ADDRESS"
+  OpBalance -> txt "BALANCE"
+  OpOrigin -> txt "ORIGIN"
+  OpCaller -> txt "CALLER"
+  OpCallvalue -> txt "CALLVALUE"
+  OpCalldataload -> txt "CALLDATALOAD"
+  OpCalldatasize -> txt "CALLDATASIZE"
+  OpCalldatacopy -> txt "CALLDATACOPY"
+  OpCodesize -> txt "CODESIZE"
+  OpCodecopy -> txt "CODECOPY"
+  OpGasprice -> txt "GASPRICE"
+  OpExtcodesize -> txt "EXTCODESIZE"
+  OpExtcodecopy -> txt "EXTCODECOPY"
+  OpReturndatasize -> txt "RETURNDATASIZE"
+  OpReturndatacopy -> txt "RETURNDATACOPY"
+  OpBlockhash -> txt "BLOCKHASH"
+  OpCoinbase -> txt "COINBASE"
+  OpTimestamp -> txt "TIMESTAMP"
+  OpNumber -> txt "NUMBER"
+  OpDifficulty -> txt "DIFFICULTY"
+  OpGaslimit -> txt "GASLIMIT"
+  OpPop -> txt "POP"
+  OpMload -> txt "MLOAD"
+  OpMstore -> txt "MSTORE"
+  OpMstore8 -> txt "MSTORE8"
+  OpSload -> txt "SLOAD"
+  OpSstore -> txt "SSTORE"
+  OpJump -> txt "JUMP"
+  OpJumpi -> txt "JUMPI"
+  OpPc -> txt "PC"
+  OpMsize -> txt "MSIZE"
+  OpGas -> txt "GAS"
+  OpJumpdest -> txt "JUMPDEST"
+  OpCreate -> txt "CREATE"
+  OpCall -> txt "CALL"
+  OpCallcode -> txt "CALLCODE"
+  OpReturn -> txt "RETURN"
+  OpDelegatecall -> txt "DELEGATECALL"
+  OpSelfdestruct -> txt "SELFDESTRUCT"
+  OpDup x -> txt "DUP" <+> str (show x)
+  OpSwap x -> txt "SWAP" <+> str (show x)
+  OpLog x -> txt "LOG" <+> str (show x)
+  OpPush x -> txt "PUSH " <+> withDefAttr wordAttr (str (show x))
+  OpRevert -> txt "REVERT"
+  OpUnknown x -> txt "UNKNOWN " <+> str (show x)
+
+selectedAttr :: AttrName; selectedAttr = "selected"
+dimAttr :: AttrName; dimAttr = "dim"
+wordAttr :: AttrName; wordAttr = "word"
+boldAttr :: AttrName; boldAttr = "bold"
+activeAttr :: AttrName; activeAttr = "active"
diff --git a/src/EVM/TTYCenteredList.hs b/src/EVM/TTYCenteredList.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/TTYCenteredList.hs
@@ -0,0 +1,71 @@
+module EVM.TTYCenteredList where
+
+-- Hard fork of brick's List that centers the currently highlighted line.
+
+import Control.Lens
+import Data.Maybe (fromMaybe)
+
+import Brick.Types
+import Brick.Widgets.Core
+import Brick.Widgets.List
+
+import qualified Data.Vector as V
+
+-- | Turn a list state value into a widget given an item drawing
+-- function.
+renderList :: (Ord n, Show n)
+           => (Bool -> e -> Widget n)
+           -- ^ Rendering function, True for the selected element
+           -> Bool
+           -- ^ Whether the list has focus
+           -> List n e
+           -- ^ The List to be rendered
+           -> Widget n
+           -- ^ rendered widget
+renderList drawElem foc l =
+    withDefAttr listAttr $
+    drawListElements foc l drawElem
+
+drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n
+drawListElements foc l drawElem =
+    Widget Greedy Greedy $ do
+        c <- getContext
+
+        let es = V.slice start num (l^.listElementsL)
+            idx = fromMaybe 0 (l^.listSelectedL)
+
+            start = max 0 $ idx - (initialNumPerHeight `div` 2)
+            num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start)
+
+            -- The number of items to show is the available height divided by
+            -- the item height...
+            initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)
+            -- ... but if the available height leaves a remainder of
+            -- an item height then we need to ensure that we render an
+            -- extra item to show a partial item at the top or bottom to
+            -- give the expected result when an item is more than one
+            -- row high. (Example: 5 rows available with item height
+            -- of 3 yields two items: one fully rendered, the other
+            -- rendered with only its top 2 or bottom 2 rows visible,
+            -- depending on how the viewport state changes.)
+            numPerHeight = initialNumPerHeight +
+                           if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL
+                           then 0
+                           else 1
+
+            -- off = start * (l^.listItemHeightL)
+
+            drawnElements = flip V.imap es $ \i e ->
+                let isSelected = i == (if start == 0 then idx else div initialNumPerHeight 2)
+                    elemWidget = drawElem isSelected e
+                    selItemAttr = if foc
+                                  then withDefAttr listSelectedFocusedAttr
+                                  else withDefAttr listSelectedAttr
+                    makeVisible = if isSelected
+                                  then visible . selItemAttr
+                                  else id
+                in makeVisible elemWidget
+
+        render $ viewport (l^.listNameL) Vertical $
+                 -- translateBy (Location (0, off)) $
+                 vBox $ V.toList drawnElements
diff --git a/src/EVM/Types.hs b/src/EVM/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/Types.hs
@@ -0,0 +1,164 @@
+{-# Language CPP #-}
+{-# Language TemplateHaskell #-}
+
+module EVM.Types where
+
+import Data.Aeson ((.:))
+import Data.Aeson (FromJSON (..))
+
+#if MIN_VERSION_aeson(1, 0, 0)
+import Data.Aeson (FromJSONKey (..), FromJSONKeyFunction (..))
+#endif
+
+import Data.Monoid ((<>))
+import Data.Bits
+import Data.ByteString (ByteString)
+import Data.ByteString.Base16 as BS16
+import Data.DoubleWord
+import Data.DoubleWord.TH
+import Data.Word (Word8)
+import Numeric (readHex, showHex)
+import Options.Generic
+
+import qualified Data.Aeson          as JSON
+import qualified Data.Aeson.Types    as JSON
+import qualified Data.ByteString     as BS
+import qualified Data.Serialize.Get  as Cereal
+import qualified Data.Text           as Text
+import qualified Data.Text.Encoding  as Text
+
+-- Some stuff for "generic programming", needed to create Word512
+import Data.Data
+
+-- We need a 512-bit word for doing ADDMOD and MULMOD with full precision.
+mkUnpackedDoubleWord "Word512" ''Word256 "Int512" ''Int256 ''Word256
+  [''Typeable, ''Data, ''Generic]
+
+newtype W256 = W256 Word256
+  deriving
+    ( Num, Integral, Real, Ord, Enum, Eq
+    , Bits, FiniteBits, Bounded, Generic
+    )
+
+newtype Addr = Addr { addressWord160 :: Word160 }
+  deriving (Num, Integral, Real, Ord, Enum, Eq, Bits, Generic)
+
+instance Read W256 where
+  readsPrec _ "0x" = [(0, "")]
+  readsPrec n s = (\(x, r) -> (W256 x, r)) <$> readsPrec n s
+
+instance Show W256 where
+  showsPrec _ s = ("0x" ++) . showHex s
+
+instance Read Addr where
+  readsPrec _ ('0':'x':s) = readHex s
+  readsPrec _ s = readHex s
+
+instance Show Addr where
+  showsPrec _ s a =
+    let h = showHex s a
+    in replicate (40 - length h) '0' ++ h
+
+showAddrWith0x :: Addr -> String
+showAddrWith0x addr = "0x" ++ show addr
+
+showWordWith0x :: W256 -> String
+showWordWith0x addr = show addr
+
+showByteStringWith0x :: ByteString -> String
+showByteStringWith0x bs = Text.unpack (Text.decodeUtf8 (BS16.encode bs))
+
+instance FromJSON W256 where
+  parseJSON v = do
+    s <- Text.unpack <$> parseJSON v
+    case reads s of
+      [(x, "")]  -> return x
+      _          -> fail $ "invalid hex word (" ++ s ++ ")"
+
+instance FromJSON Addr where
+  parseJSON v = do
+    s <- Text.unpack <$> parseJSON v
+    case reads s of
+      [(x, "")] -> return x
+      _         -> fail $ "invalid address (" ++ s ++ ")"
+
+#if MIN_VERSION_aeson(1, 0, 0)
+
+instance FromJSONKey W256 where
+  fromJSONKey = FromJSONKeyTextParser $ \s ->
+    case reads (Text.unpack s) of
+      [(x, "")]  -> return x
+      _          -> fail $ "invalid word (" ++ Text.unpack s ++ ")"
+
+instance FromJSONKey Addr where
+  fromJSONKey = FromJSONKeyTextParser $ \s ->
+    case reads (Text.unpack s) of
+      [(x, "")] -> return x
+      _         -> fail $ "invalid word (" ++ Text.unpack s ++ ")"
+
+#endif
+
+instance ParseField W256
+instance ParseFields W256
+instance ParseRecord W256 where
+  parseRecord = fmap getOnly parseRecord
+
+instance ParseField Addr
+instance ParseFields Addr
+instance ParseRecord Addr where
+  parseRecord = fmap getOnly parseRecord
+
+hexByteString :: String -> ByteString -> ByteString
+hexByteString msg bs =
+  case BS16.decode bs of
+    (x, "") -> x
+    _ -> error ("invalid hex bytestring for " ++ msg)
+
+hexText :: Text -> ByteString
+hexText t =
+  case BS16.decode (Text.encodeUtf8 (Text.drop 2 t)) of
+    (x, "") -> x
+    _ -> error ("invalid hex bytestring " ++ show t)
+
+readN :: Integral a => String -> a
+readN s = fromIntegral (read s :: Integer)
+
+wordField :: JSON.Object -> Text -> JSON.Parser W256
+wordField x f = (read . Text.unpack)
+                  <$> (x .: f)
+
+addrField :: JSON.Object -> Text -> JSON.Parser Addr
+addrField x f = (read . Text.unpack) <$> (x .: f)
+
+dataField :: JSON.Object -> Text -> JSON.Parser ByteString
+dataField x f = hexText <$> (x .: f)
+
+toWord512 :: W256 -> Word512
+toWord512 (W256 x) = fromHiAndLo 0 x
+
+fromWord512 :: Word512 -> W256
+fromWord512 x = W256 (loWord x)
+
+{-# SPECIALIZE num :: Word8 -> W256 #-}
+num :: (Integral a, Num b) => a -> b
+num = fromIntegral
+
+padLeft :: Int -> ByteString -> ByteString
+padLeft n xs = BS.replicate (n - BS.length xs) 0 <> xs
+
+padRight :: Int -> ByteString -> ByteString
+padRight n xs = xs <> BS.replicate (n - BS.length xs) 0
+
+word :: ByteString -> W256
+word xs = case Cereal.runGet m (padLeft 32 xs) of
+            Left _ -> error "internal error"
+            Right x -> W256 x
+  where
+    m = do a <- Cereal.getWord64be
+           b <- Cereal.getWord64be
+           c <- Cereal.getWord64be
+           d <- Cereal.getWord64be
+           return $ fromHiAndLo (fromHiAndLo a b) (fromHiAndLo c d)
+
+byteAt :: (Bits a, Bits b, Integral a, Num b) => a -> Int -> b
+byteAt x j = num (x `shiftR` (j * 8)) .&. 0xff
diff --git a/src/EVM/UnitTest.hs b/src/EVM/UnitTest.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/UnitTest.hs
@@ -0,0 +1,569 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module EVM.UnitTest where
+
+import Prelude hiding (Word)
+
+import EVM
+import EVM.ABI
+import EVM.Dapp
+import EVM.Debug (srcMapCodePos)
+import EVM.Exec
+import EVM.Format
+import EVM.Keccak
+import EVM.Solidity
+import EVM.Types
+import EVM.Concrete (blob, w256, forceConcreteBlob, Blob (B), wordAt)
+
+import qualified EVM.FeeSchedule as FeeSchedule
+
+import EVM.Stepper (Stepper)
+import qualified EVM.Stepper as Stepper
+import qualified Control.Monad.Operational as Operational
+
+import Control.Lens hiding (Indexed)
+import Control.Monad.State.Strict hiding (state)
+import qualified Control.Monad.State.Strict as State
+
+import Control.Monad.Par.Class (spawn_)
+import Control.Monad.Par.IO (runParIO)
+
+import Data.ByteString    (ByteString)
+import Data.Foldable      (toList)
+import Data.Map           (Map)
+import Data.Maybe         (fromMaybe, catMaybes, fromJust, fromMaybe, mapMaybe)
+import Data.Monoid        ((<>))
+import Data.Text          (Text, pack, unpack)
+import Data.Text          (isPrefixOf, stripSuffix, intercalate)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Word          (Word32)
+import System.Environment (lookupEnv)
+import System.IO          (hFlush, stdout)
+
+import qualified Control.Monad.Par.Class as Par
+import qualified Data.ByteString as BS
+import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+
+import Data.MultiSet (MultiSet)
+import qualified Data.MultiSet as MultiSet
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+
+data UnitTestOptions = UnitTestOptions
+  {
+    oracle     :: Query -> IO (EVM ())
+  , verbose    :: Bool
+  , match      :: Text
+  , vmModifier :: VM -> VM
+  , testParams :: TestVMParams
+  }
+
+data TestVMParams = TestVMParams
+  { testAddress       :: Addr
+  , testCaller        :: Addr
+  , testOrigin        :: Addr
+  , testGasCreate     :: W256
+  , testGasCall       :: W256
+  , testBalanceCreate :: W256
+  , testBalanceCall   :: W256
+  , testCoinbase      :: Addr
+  , testNumber        :: W256
+  , testTimestamp     :: W256
+  , testGaslimit      :: W256
+  , testGasprice      :: W256
+  , testDifficulty    :: W256
+  }
+
+defaultGasForCreating :: W256
+defaultGasForCreating = 0xffffffffffff
+
+defaultGasForInvoking :: W256
+defaultGasForInvoking = 0xffffffffffff
+
+defaultBalanceForCreator :: W256
+defaultBalanceForCreator = 0xffffffffffffffffffffffff
+
+defaultBalanceForCreated :: W256
+defaultBalanceForCreated = 0xffffffffffffffffffffffff
+
+type ABIMethod = Text
+
+-- | Assuming a constructor is loaded, this stepper will run the constructor
+-- to create the test contract, give it an initial balance, and run `setUp()'.
+initializeUnitTest :: UnitTestOptions -> Stepper ()
+initializeUnitTest UnitTestOptions { .. } = do
+
+  -- Maybe modify the initial VM, e.g. to load library code
+  Stepper.evm (modify vmModifier)
+
+  -- Make a trace entry for running the constructor
+  Stepper.evm (pushTrace (EntryTrace "constructor"))
+
+  -- Constructor is loaded; run until it returns code
+  B bytes <- Stepper.execFullyOrFail
+  addr <- Stepper.evm (use (state . contract))
+
+  -- Mutate the current contract to use the new code
+  Stepper.evm $ replaceCodeOfSelf bytes
+
+  -- Increase the nonce, in case the constructor created contracts
+  Just n <- Stepper.evm (preuse (env . contracts . ix ethrunAddress . nonce))
+  Stepper.evm $ assign (env . contracts . ix addr . nonce) n
+
+  -- Give a balance to the test target
+  Stepper.evm $
+    env . contracts . ix addr . balance += w256 (testBalanceCreate testParams)
+
+  -- Initialize the test contract
+  Stepper.evm (popTrace >> pushTrace (EntryTrace "initialize test"))
+  Stepper.evm $
+    setupCall addr "setUp()" (testBalanceCall testParams)
+
+  Stepper.note "Running `setUp()'"
+
+  -- Let `setUp()' run to completion
+  void Stepper.execFullyOrFail
+  Stepper.evm popTrace
+
+-- | Assuming a test contract is loaded and initialized, this stepper
+-- will run the specified test method and return whether it succeeded.
+runUnitTest :: UnitTestOptions -> ABIMethod -> Stepper Bool
+runUnitTest UnitTestOptions { .. } method = do
+  -- Fail immediately if there was a failure in the setUp() phase
+  Stepper.evm (use result) >>=
+    \case
+      Just (VMFailure e) -> do
+        Stepper.evm (pushTrace (ErrorTrace e))
+        pure False
+
+      _ -> do
+        -- Decide whether the test is supposed to fail or succeed
+        let shouldFail = "testFail" `isPrefixOf` method
+
+        -- The test subject should be loaded and initialized already
+        addr <- Stepper.evm $ use (state . contract)
+
+        -- Set up the call to the test method
+        Stepper.evm $
+          setupCall addr method (testGasCall testParams)
+        Stepper.evm (pushTrace (EntryTrace method))
+        Stepper.note "Running unit test"
+
+        -- Try running the test method
+        bailed <-
+          Stepper.execFully >>=
+            either (const (pure True)) (const (pure False))
+
+        -- If we failed, put the error in the trace.
+        -- It's not clear to me right now why this doesn't happen somewhere else.
+        Just problem <- Stepper.evm $ use result
+        case problem of
+          VMFailure e ->
+            Stepper.evm (pushTrace (ErrorTrace e))
+          _ ->
+            pure ()
+
+        -- Ask whether any assertions failed
+        Stepper.evm $ popTrace
+        Stepper.evm $ setupCall addr "failed()" 10000
+        Stepper.note "Checking whether assertions failed"
+        AbiBool failed <- Stepper.execFullyOrFail >>= Stepper.decode AbiBoolType
+
+        -- Return true if the test was successful
+        pure (shouldFail == (bailed || failed))
+
+tick :: Text -> IO ()
+tick x = Text.putStr x >> hFlush stdout
+
+interpret
+  :: UnitTestOptions
+  -> Stepper a
+  -> StateT VM IO (Either Stepper.Failure a)
+interpret opts =
+  eval . Operational.view
+
+  where
+    eval
+      :: Operational.ProgramView Stepper.Action a
+      -> StateT VM IO (Either Stepper.Failure a)
+
+    eval (Operational.Return x) =
+      pure (Right x)
+
+    eval (action Operational.:>>= k) =
+      case action of
+        Stepper.Exec ->
+          exec >>= interpret opts . k
+        Stepper.Wait q ->
+          do m <- liftIO (oracle opts q)
+             State.state (runState m) >> interpret opts (k ())
+        Stepper.Note _ ->
+          interpret opts (k ())
+        Stepper.Fail e ->
+          pure (Left e)
+        Stepper.EVM m ->
+          State.state (runState m) >>= interpret opts . k
+
+-- | This is like an unresolved source mapping.
+data OpLocation = OpLocation
+  { srcCodehash :: !W256
+  , srcOpIx     :: !Int
+  } deriving (Eq, Ord, Show)
+
+srcMapForOpLocation :: DappInfo -> OpLocation -> Maybe SrcMap
+srcMapForOpLocation dapp (OpLocation hash opIx) =
+  case preview (dappSolcByHash . ix hash) dapp of
+    Nothing -> Nothing
+    Just (codeType, solc) ->
+      let
+        vec =
+          case codeType of
+            Runtime  -> view runtimeSrcmap solc
+            Creation -> view creationSrcmap solc
+      in
+        preview (ix opIx) vec
+
+type CoverageState = (VM, MultiSet OpLocation)
+
+currentOpLocation :: VM -> OpLocation
+currentOpLocation vm =
+  case currentContract vm of
+    Nothing ->
+      error "internal error: why no contract?"
+    Just c ->
+      OpLocation
+        (view codehash c)
+        (fromMaybe (error "internal error: op ix") (vmOpIx vm))
+
+execWithCoverage :: StateT CoverageState IO VMResult
+execWithCoverage = do
+  -- This is just like `exec` except for every instruction evaluated,
+  -- we also increment a counter indexed by the current code location.
+  vm0 <- use _1
+  case view result vm0 of
+    Nothing -> do
+      vm1 <- zoom _1 (State.state (runState exec1) >> get)
+      zoom _2 (modify (MultiSet.insert (currentOpLocation vm1)))
+      execWithCoverage
+    Just r ->
+      pure r
+
+interpretWithCoverage
+  :: UnitTestOptions
+  -> Stepper a
+  -> StateT CoverageState IO (Either Stepper.Failure a)
+interpretWithCoverage opts =
+  eval . Operational.view
+
+  where
+    eval
+      :: Operational.ProgramView Stepper.Action a
+      -> StateT CoverageState IO (Either Stepper.Failure a)
+
+    eval (Operational.Return x) =
+      pure (Right x)
+
+    eval (action Operational.:>>= k) =
+      case action of
+        Stepper.Exec ->
+          execWithCoverage >>= interpretWithCoverage opts . k
+        Stepper.Wait q ->
+          do m <- liftIO (oracle opts q)
+             zoom _1 (State.state (runState m)) >> interpretWithCoverage opts (k ())
+        Stepper.Note _ ->
+          interpretWithCoverage opts (k ())
+        Stepper.Fail e ->
+          pure (Left e)
+        Stepper.EVM m ->
+          zoom _1 (State.state (runState m)) >>= interpretWithCoverage opts . k
+
+coverageReport
+  :: DappInfo
+  -> MultiSet SrcMap
+  -> Map Text (Vector (Int, ByteString))
+coverageReport dapp cov =
+  let
+    sources :: SourceCache
+    sources = view dappSources dapp
+
+    allPositions :: Set (Text, Int)
+    allPositions =
+      ( Set.fromList
+      . mapMaybe (srcMapCodePos sources)
+      . toList
+      $ mconcat
+        ( view dappSolcByName dapp
+        & Map.elems
+        & map (\x -> view runtimeSrcmap x <> view creationSrcmap x)
+        )
+      )
+
+    srcMapCov :: MultiSet (Text, Int)
+    srcMapCov = MultiSet.mapMaybe (srcMapCodePos sources) cov
+
+    -- linesByName :: Map Text (Vector ByteString)
+    linesByName =
+      ( Map.fromList
+      . map
+          (\(k, v) ->
+             (fst (fromJust (Map.lookup k (view sourceFiles sources))), v))
+      . Map.toList
+      $ view sourceLines sources
+      )
+
+    f :: Text -> Vector ByteString -> Vector (Int, ByteString)
+    f name xs =
+      Vector.imap
+        (\i bs ->
+           let
+             n =
+               if Set.member (name, i + 1) allPositions
+               then MultiSet.occur (name, i + 1) srcMapCov
+               else -1
+           in (n, bs))
+        xs
+  in
+    Map.mapWithKey f linesByName
+
+coverageForUnitTestContract
+  :: UnitTestOptions
+  -> Map Text SolcContract
+  -> SourceCache
+  -> (Text, [Text])
+  -> IO (MultiSet SrcMap)
+coverageForUnitTestContract
+  opts@(UnitTestOptions {..}) contractMap sources (name, testNames) = do
+
+  -- Look for the wanted contract by name from the Solidity info
+  case preview (ix name) contractMap of
+    Nothing ->
+      -- Fail if there's no such contract
+      error $ "Contract " ++ unpack name ++ " not found"
+
+    Just theContract -> do
+      -- Construct the initial VM and begin the contract's constructor
+      let vm0 = initialUnitTestVm opts theContract (Map.elems contractMap)
+      (vm1, cov1) <-
+        execStateT
+          (interpretWithCoverage opts
+            (Stepper.enter name >> initializeUnitTest opts))
+          (vm0, mempty)
+
+      -- Define the thread spawner for test cases
+      let
+        runOne testName = spawn_ . liftIO $ do
+          (x, (_, cov)) <-
+            runStateT
+              (interpretWithCoverage opts (runUnitTest opts testName))
+              (vm1, mempty)
+          case x of
+            Right True -> pure cov
+            _ -> error "test failure during coverage analysis; fix it!"
+
+      -- Run all the test cases in parallel and gather their coverages
+      covs <-
+        runParIO (mapM runOne testNames >>= mapM Par.get)
+
+      -- Sum up all the coverage counts
+      let cov2 = MultiSet.unions (cov1 : covs)
+
+      -- Gather the dapp-related metadata
+      let dapp = dappInfo "." contractMap sources
+
+      pure (MultiSet.mapMaybe (srcMapForOpLocation dapp) cov2)
+
+runUnitTestContract
+  :: UnitTestOptions
+  -> Map Text SolcContract
+  -> SourceCache
+  -> (Text, [Text])
+  -> IO Bool
+runUnitTestContract
+  opts@(UnitTestOptions {..}) contractMap sources (name, testNames) = do
+
+  -- Print a header
+  putStrLn $ "Running " ++ show (length testNames) ++ " tests for "
+    ++ unpack name
+
+  -- Look for the wanted contract by name from the Solidity info
+  case preview (ix name) contractMap of
+    Nothing ->
+      -- Fail if there's no such contract
+      error $ "Contract " ++ unpack name ++ " not found"
+
+    Just theContract -> do
+      -- Construct the initial VM and begin the contract's constructor
+      let vm0 = initialUnitTestVm opts theContract (Map.elems contractMap)
+      vm1 <-
+        execStateT
+          (interpret opts
+            (Stepper.enter name >> initializeUnitTest opts))
+          vm0
+
+      -- Gather the dapp-related metadata
+      let dapp = dappInfo "." contractMap sources
+
+      -- Define the thread spawner for test cases
+      let
+        runOne testName = do
+          x <-
+            runStateT
+              (interpret opts (runUnitTest opts testName))
+              vm1
+          case x of
+             (Right True,  vm) ->
+               let
+                 gasSpent =
+                   view burned vm - view burned vm1
+                 gasText =
+                   pack . show $
+                     (fromIntegral gasSpent :: Integer)
+               in
+                 pure
+                   ( "PASS " <> testName <> " (gas: " <> gasText <> ")"
+                   , Right (passOutput vm testName)
+                   )
+             (Right False, vm) ->
+               pure ("FAIL " <> testName, Left (failOutput vm dapp testName))
+             (Left _, _)       ->
+               pure ("OOPS " <> testName, Left ("VM error for " <> testName))
+        inform = \(x, y) -> Text.putStrLn x >> pure y
+
+      -- Run all the test cases and print their status updates
+      details <-
+        mapM (\x -> runOne x >>= inform) testNames
+
+      let fails = [x | Left x <- details]
+
+      tick "\n"
+      tick (Text.unlines fails)
+
+      pure (null fails)
+
+indentLines :: Int -> Text -> Text
+indentLines n s =
+  let p = Text.replicate n " "
+  in Text.unlines (map (p <>) (Text.lines s))
+
+passOutput :: VM -> Text -> Text
+passOutput _ testName = "PASS " <> testName
+
+failOutput :: VM -> DappInfo -> Text -> Text
+failOutput vm dapp testName = mconcat $
+  [ "Failure: "
+  , fromMaybe "" (stripSuffix "()" testName)
+  , "\n"
+  , indentLines 2 (formatTestLogs (view dappEventMap dapp) (view logs vm))
+  , indentLines 2 (showTraceTree dapp vm)
+  , "\n"
+  ]
+
+formatTestLogs :: Map W256 Event -> Seq.Seq Log -> Text
+formatTestLogs events xs =
+  case catMaybes (toList (fmap (formatTestLog events) xs)) of
+    [] -> "\n"
+    ys -> "\n" <> intercalate "\n" ys <> "\n\n"
+
+formatTestLog :: Map W256 Event -> Log -> Maybe Text
+formatTestLog _ (Log _ _ []) = Nothing
+formatTestLog events (Log _ b (t:_)) =
+  let
+    name  = getEventName event
+    args  = forceConcreteBlob b
+    event = getEvent t events
+
+  in case name of
+
+    "log_bytes32" ->
+      Just $ formatBytes args
+
+    "log_named_bytes32" ->
+      let key = BS.take 32 args
+          val = BS.drop 32 args
+      in Just $ formatString key <> ": " <> formatBytes val
+
+    "log_named_address" ->
+      let key = BS.take 32 args
+          val = BS.drop 44 args
+      in Just $ formatString key <> ": " <> formatBinary val
+
+  -- TODO: event log_named_decimal_int  (bytes32 key, int val, uint decimals);
+  -- TODO: event log_named_decimal_uint (bytes32 key, uint val, uint decimals);
+
+    "log_named_int" ->
+      let key = BS.take 32 args
+          val = wordAt 32 args
+      in Just $ formatString key <> ": " <> showDec Signed val
+
+    "log_named_uint" ->
+      let key = BS.take 32 args
+          val = wordAt 32 args
+      in Just $ formatString key <> ": " <> showDec Unsigned val
+
+    _ ->
+      Nothing
+
+word32Bytes :: Word32 -> ByteString
+word32Bytes x = BS.pack [byteAt x (3 - i) | i <- [0..3]]
+
+setupCall :: Addr -> Text -> W256 -> EVM ()
+setupCall target abi allowance = do
+  resetState
+  loadContract target
+  assign (state . calldata) (blob (word32Bytes (abiKeccak (encodeUtf8 abi))))
+  assign (state . gas) (w256 allowance)
+
+initialUnitTestVm :: UnitTestOptions -> SolcContract -> [SolcContract] -> VM
+initialUnitTestVm (UnitTestOptions {..}) theContract _ =
+  let
+    TestVMParams {..} = testParams
+    vm = makeVm $ VMOpts
+           { vmoptCode = view creationCode theContract
+           , vmoptCalldata = ""
+           , vmoptValue = 0
+           , vmoptAddress = testAddress
+           , vmoptCaller = testCaller
+           , vmoptOrigin = testOrigin
+           , vmoptGas = testGasCreate
+           , vmoptCoinbase = testCoinbase
+           , vmoptNumber = testNumber
+           , vmoptTimestamp = testTimestamp
+           , vmoptGaslimit = testGaslimit
+           , vmoptGasprice = testGasprice
+           , vmoptDifficulty = testDifficulty
+           , vmoptSchedule = FeeSchedule.metropolis
+           }
+    creator =
+      initialContract mempty
+        & set nonce 1
+        & set balance (w256 testBalanceCreate)
+  in vm
+    & set (env . contracts . at ethrunAddress) (Just creator)
+
+getParametersFromEnvironmentVariables :: IO TestVMParams
+getParametersFromEnvironmentVariables = do
+  let
+    getWord s def = maybe def read <$> lookupEnv s
+    getAddr s def = maybe def read <$> lookupEnv s
+
+  TestVMParams
+    <$> getAddr "DAPP_TEST_ADDRESS" (newContractAddress ethrunAddress 1)
+    <*> getAddr "DAPP_TEST_CALLER" ethrunAddress
+    <*> getAddr "DAPP_TEST_ORIGIN" ethrunAddress
+    <*> getWord "DAPP_TEST_GAS_CREATE" defaultGasForCreating
+    <*> getWord "DAPP_TEST_GAS_CALL" defaultGasForInvoking
+    <*> getWord "DAPP_TEST_BALANCE_CREATE" defaultBalanceForCreator
+    <*> getWord "DAPP_TEST_BALANCE_CALL" defaultBalanceForCreated
+    <*> getAddr "DAPP_TEST_COINBASE" 0
+    <*> getWord "DAPP_TEST_NUMBER" 512
+    <*> getWord "DAPP_TEST_TIMESTAMP" 1
+    <*> getWord "DAPP_TEST_GAS_LIMIT" 0
+    <*> getWord "DAPP_TEST_GAS_PRICE" 0
+    <*> getWord "DAPP_TEST_DIFFICULTY" 1
diff --git a/src/EVM/VMTest.hs b/src/EVM/VMTest.hs
new file mode 100644
--- /dev/null
+++ b/src/EVM/VMTest.hs
@@ -0,0 +1,215 @@
+{-# Language CPP #-}
+{-# Language TemplateHaskell #-}
+
+module EVM.VMTest
+  ( Case
+#if MIN_VERSION_aeson(1, 0, 0)
+  , parseSuite
+#endif
+  , vmForCase
+  , checkExpectation
+  , interpret
+  ) where
+
+import qualified EVM
+import qualified EVM.Concrete as EVM
+import qualified EVM.Exec
+import qualified EVM.FeeSchedule as EVM.FeeSchedule
+import qualified EVM.Stepper as Stepper
+import qualified EVM.Fetch as Fetch
+
+import Control.Monad.State.Strict (runState, join)
+import qualified Control.Monad.Operational as Operational
+import qualified Control.Monad.State.Class as State
+
+import EVM (EVM)
+import EVM.Stepper (Stepper)
+import EVM.Types
+
+import Control.Lens
+
+import IPPrint.Colored (cpprint)
+
+import Data.ByteString (ByteString)
+import Data.Aeson ((.:), (.:?))
+import Data.Aeson (FromJSON (..))
+import Data.Map (Map)
+import Data.List (intercalate)
+
+import qualified Data.Map          as Map
+import qualified Data.Aeson        as JSON
+import qualified Data.Aeson.Types  as JSON
+import qualified Data.ByteString.Lazy  as Lazy
+
+data Case = Case
+  { testVmOpts      :: EVM.VMOpts
+  , testContracts   :: Map Addr Contract
+  , testExpectation :: Maybe Expectation
+  } deriving Show
+
+data Contract = Contract
+  { contractBalance :: W256
+  , contractCode    :: ByteString
+  , contractNonce   :: W256
+  , contractStorage :: Map W256 W256
+  } deriving Show
+
+data Expectation = Expectation
+  { expectedOut :: ByteString
+  , expectedContracts :: Map Addr Contract
+  , expectedGas :: W256
+  } deriving Show
+
+checkExpectation :: Case -> EVM.VM -> IO Bool
+checkExpectation x vm =
+  case (testExpectation x, view EVM.result vm) of
+    (Just expectation, Just (EVM.VMSuccess (EVM.B output))) -> do
+      let
+        (s1, b1) = ("bad-state", checkExpectedContracts vm (expectedContracts expectation))
+        (s2, b2) = ("bad-output", checkExpectedOut output (expectedOut expectation))
+        (s3, b3) = ("bad-gas", checkExpectedGas vm (expectedGas expectation))
+        ss = map fst (filter (not . snd) [(s1, b1), (s2, b2), (s3, b3)])
+      putStr (intercalate " " ss)
+      return (b1 && b2 && b3)
+    (Nothing, Just (EVM.VMSuccess _)) -> do
+      putStr "unexpected-success"
+      return False
+    (Nothing, Just (EVM.VMFailure _)) ->
+      return True
+    (Just _, Just (EVM.VMFailure _)) -> do
+      putStr "unexpected-failure"
+      return False
+    (_, Nothing) -> do
+      cpprint (view EVM.result vm)
+      error "internal error"
+
+checkExpectedOut :: ByteString -> ByteString -> Bool
+checkExpectedOut output expected =
+  output == expected
+
+checkExpectedContracts :: EVM.VM -> Map Addr Contract -> Bool
+checkExpectedContracts vm expected =
+  realizeContracts expected == vm ^. EVM.env . EVM.contracts . to (fmap clearZeroStorage)
+
+clearZeroStorage :: EVM.Contract -> EVM.Contract
+clearZeroStorage =
+  over EVM.storage (Map.filterWithKey (\_ x -> x /= 0))
+
+checkExpectedGas :: EVM.VM -> W256 -> Bool
+checkExpectedGas vm expected =
+  case vm ^. EVM.state . EVM.gas of
+    EVM.C _ x | x == expected -> True
+    _ -> False
+
+#if MIN_VERSION_aeson(1, 0, 0)
+
+instance FromJSON Contract where
+  parseJSON (JSON.Object v) = Contract
+    <$> v .: "balance"
+    <*> (hexText <$> v .: "code")
+    <*> v .: "nonce"
+    <*> v .: "storage"
+  parseJSON invalid =
+    JSON.typeMismatch "VM test case contract" invalid
+
+instance FromJSON Case where
+  parseJSON (JSON.Object v) = Case
+    <$> parseVmOpts v
+    <*> parseContracts v
+    <*> parseExpectation v
+  parseJSON invalid =
+      JSON.typeMismatch "VM test case" invalid
+
+parseVmOpts :: JSON.Object -> JSON.Parser EVM.VMOpts
+parseVmOpts v =
+  do envV  <- v .: "env"
+     execV <- v .: "exec"
+     case (envV, execV) of
+       (JSON.Object env, JSON.Object exec) ->
+         EVM.VMOpts
+           <$> dataField exec "code"
+           <*> dataField exec "data"
+           <*> wordField exec "value"
+           <*> addrField exec "address"
+           <*> addrField exec "caller"
+           <*> addrField exec "origin"
+           <*> wordField exec "gas" -- XXX: correct?
+           <*> wordField env  "currentNumber"
+           <*> wordField env  "currentTimestamp"
+           <*> addrField env  "currentCoinbase"
+           <*> wordField env  "currentDifficulty"
+           <*> wordField env  "currentGasLimit"
+           <*> wordField exec "gasPrice"
+           <*> pure (EVM.FeeSchedule.homestead)
+       _ ->
+         JSON.typeMismatch "VM test case" (JSON.Object v)
+
+parseContracts ::
+  JSON.Object -> JSON.Parser (Map Addr Contract)
+parseContracts v =
+  v .: "pre" >>= parseJSON
+
+parseExpectation :: JSON.Object -> JSON.Parser (Maybe Expectation)
+parseExpectation v =
+  do out       <- fmap hexText <$> v .:? "out"
+     contracts <- v .:? "post"
+     gas       <- v .:? "gas"
+     case (out, contracts, gas) of
+       (Just x, Just y, Just z) ->
+         return (Just (Expectation x y z))
+       _ ->
+         return Nothing
+
+parseSuite ::
+  Lazy.ByteString -> Either String (Map String Case)
+parseSuite = JSON.eitherDecode'
+
+#endif
+
+realizeContracts :: Map Addr Contract -> Map Addr EVM.Contract
+realizeContracts = Map.fromList . map f . Map.toList
+  where
+    f (a, x) = (a, realizeContract x)
+
+realizeContract :: Contract -> EVM.Contract
+realizeContract x =
+  EVM.initialContract (contractCode x)
+    & EVM.balance .~ EVM.w256 (contractBalance x)
+    & EVM.nonce   .~ EVM.w256 (contractNonce x)
+    & EVM.storage .~ (
+        Map.fromList .
+        map (\(k, v) -> (EVM.w256 k, EVM.w256 v)) .
+        Map.toList $ contractStorage x
+        )
+
+vmForCase :: Case -> EVM.VM
+vmForCase x =
+  EVM.makeVm (testVmOpts x)
+    & EVM.env . EVM.contracts .~ realizeContracts (testContracts x)
+    & EVM.execMode .~ EVM.ExecuteAsVMTest
+
+interpret :: Stepper a -> EVM a
+interpret =
+  eval . Operational.view
+
+  where
+    eval
+      :: Operational.ProgramView Stepper.Action a
+      -> EVM a
+
+    eval (Operational.Return x) =
+      pure x
+
+    eval (action Operational.:>>= k) =
+      case action of
+        Stepper.Exec ->
+          EVM.Exec.exec >>= interpret . k
+        Stepper.Wait q ->
+          do join (Fetch.zero q)
+             interpret (k ())
+        Stepper.Note _ ->
+          interpret (k ())
+        Stepper.Fail _ ->
+          error "VMTest stepper not supposed to fail"
+        Stepper.EVM m ->
+          State.state (runState m) >>= interpret . k
diff --git a/test/test.hs b/test/test.hs
new file mode 100644
--- /dev/null
+++ b/test/test.hs
@@ -0,0 +1,197 @@
+{-# Language OverloadedStrings #-}
+{-# Language QuasiQuotes #-}
+
+import Data.Text (Text)
+import Data.ByteString (ByteString)
+
+import qualified Data.Text as Text
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as Hex
+
+import Test.Tasty
+import Test.Tasty.QuickCheck (testProperty, Arbitrary (..), NonNegative (..))
+import Test.Tasty.HUnit
+
+import Control.Monad.State.Strict (execState, runState)
+import Control.Lens
+
+import Data.Monoid
+import qualified Data.Vector as Vector
+import Data.String.Here
+
+import Data.Binary.Put (runPut)
+import Data.Binary.Get (runGetOrFail)
+
+import EVM
+import EVM.ABI
+import EVM.Concrete
+import EVM.Exec
+import EVM.Solidity
+import EVM.Types
+import EVM.Precompiled
+
+main :: IO ()
+main = defaultMain $ testGroup "hevm"
+  [ testGroup "ABI"
+    [ testProperty "Put/get inverse" $ \x ->
+        case runGetOrFail (getAbi (abiValueType x)) (runPut (putAbi x)) of
+          Right ("", _, x') -> x' == x
+          _ -> False
+    ]
+
+  , testGroup "Solidity expressions"
+    [ testCase "Trivial" $ do
+        SolidityCall "x = 3;" []
+          ===> AbiUInt 256 3
+
+    , testCase "Arithmetic" $ do
+        SolidityCall "x = a + 1;"
+          [AbiUInt 256 1] ===> AbiUInt 256 2
+        SolidityCall "x = a - 1;"
+          [AbiUInt 8 0] ===> AbiUInt 8 255
+
+    , testCase "keccak256()" $ do
+        SolidityCall "x = uint(keccak256(a));"
+          [AbiString ""] ===> AbiUInt 256 0xc5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470
+    ]
+
+  , testGroup "ecrecover"
+    [ testCase "Example 1" $
+        let
+          h = "0x0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"
+          r = "0xc84e55cee2032ea541a32bf6749e10c8b9344c92061724c4e751600f886f4732"
+          s = "0x1542b6457e91098682138856165381453b3d0acae2470286fd8c8a09914b1b5d"
+        in SolidityCall
+             (Text.unlines
+               [ "bytes32 h = keccak256(\"\\x19Ethereum Signed Message:\\n32\", d);"
+               , "x = ecrecover(h, a, b, c);"
+               ])
+             [ AbiUInt 8 28
+             , AbiBytes 32 (hexText r)
+             , AbiBytes 32 (hexText s)
+             , AbiBytes 32 (hexText h)
+             ]
+             ===>
+             AbiAddress 0x2d5e56d45c63150d937f2182538a0f18510cb11f
+    ]
+  , testGroup "Precompiled contracts" $
+      [ testGroup "Example (reverse)"
+          [ testCase "success" $
+              assertEqual "example contract reverses"
+                (execute 0xdeadbeef "foobar" 6) (Just "raboof")
+          , testCase "failure" $
+              assertEqual "example contract fails on length mismatch"
+                (execute 0xdeadbeef "foobar" 5) Nothing
+          ]
+
+      , testGroup "ECRECOVER"
+          [ testCase "success" $ do
+              let
+                r = hex "c84e55cee2032ea541a32bf6749e10c8b9344c92061724c4e751600f886f4732"
+                s = hex "1542b6457e91098682138856165381453b3d0acae2470286fd8c8a09914b1b5d"
+                v = hex "000000000000000000000000000000000000000000000000000000000000001c"
+                h = hex "513954cf30af6638cb8f626bd3f8c39183c26784ce826084d9d267868a18fb31"
+                a = hex "0000000000000000000000002d5e56d45c63150d937f2182538a0f18510cb11f"
+              assertEqual "successful recovery"
+                (Just a)
+                (execute 1 (h <> v <> r <> s) 32)
+          , testCase "fail on made up values" $ do
+              let
+                r = hex "c84e55cee2032ea541a32bf6749e10c8b9344c92061724c4e751600f886f4731"
+                s = hex "1542b6457e91098682138856165381453b3d0acae2470286fd8c8a09914b1b5d"
+                v = hex "000000000000000000000000000000000000000000000000000000000000001c"
+                h = hex "513954cf30af6638cb8f626bd3f8c39183c26784ce826084d9d267868a18fb31"
+              assertEqual "fail because bit flip"
+                Nothing
+                (execute 1 (h <> v <> r <> s) 32)
+          ]
+      ]
+
+  , testGroup "Byte/word manipulations"
+    [ testProperty "padLeft length" $ \n (Bytes bs) ->
+        BS.length (padLeft n bs) == max n (BS.length bs)
+    , testProperty "padLeft identity" $ \(Bytes bs) ->
+        padLeft (BS.length bs) bs == bs
+    , testProperty "padRight length" $ \n (Bytes bs) ->
+        BS.length (padLeft n bs) == max n (BS.length bs)
+    , testProperty "padRight identity" $ \(Bytes bs) ->
+        padLeft (BS.length bs) bs == bs
+    , testProperty "padLeft zeroing" $ \(NonNegative n) (Bytes bs) ->
+        let x = BS.take n (padLeft (BS.length bs + n) bs)
+            y = BS.replicate n 0
+        in x == y
+    ]
+  ]
+
+  where
+    (===>) = assertSolidityComputation
+
+hex :: ByteString -> ByteString
+hex s =
+  case Hex.decode s of
+    (x, "") -> x
+    _ -> error "internal error"
+
+singleContract :: Text -> Text -> IO (Maybe ByteString)
+singleContract x s =
+  solidity x [i|
+    contract ${x} { ${s} }
+  |]
+
+runStatements
+  :: Text -> [AbiValue] -> AbiType
+  -> IO (Maybe ByteString)
+runStatements stmts args t = do
+  let params =
+        Text.intercalate ", "
+          (map (\(x, c) -> abiTypeSolidity (abiValueType x)
+                             <> " " <> Text.pack [c])
+            (zip args "abcdefg"))
+      sig =
+        "foo(" <> Text.intercalate ","
+                    (map (abiTypeSolidity . abiValueType) args) <> ")"
+
+  Just x <- singleContract "X" [i|
+    function foo(${params}) public pure returns (${abiTypeSolidity t} x) {
+      ${stmts}
+    }
+  |]
+
+  case runState exec (vmForEthrunCreation x) of
+    (VMSuccess (B targetCode), vm1) -> do
+      let target = view (state . contract) vm1
+          vm2 = execState (replaceCodeOfSelf targetCode) vm1
+      case flip runState vm2
+             (do resetState
+                 assign (state . gas) 0xffffffffffffffff -- kludge
+                 loadContract target
+                 assign (state . calldata)
+                   (B (abiCalldata sig (Vector.fromList args)))
+                 exec) of
+        (VMSuccess (B out), _) ->
+          return (Just out)
+        (VMFailure problem, _) -> do
+          print problem
+          return Nothing
+    _ ->
+      return Nothing
+
+newtype Bytes = Bytes ByteString
+  deriving Eq
+
+instance Show Bytes where
+  showsPrec _ (Bytes x) _ = show (BS.unpack x)
+
+instance Arbitrary Bytes where
+  arbitrary = fmap (Bytes . BS.pack) arbitrary
+
+data Invocation
+  = SolidityCall Text [AbiValue]
+  deriving Show
+
+assertSolidityComputation :: Invocation -> AbiValue -> IO ()
+assertSolidityComputation (SolidityCall s args) x =
+  do y <- runStatements s args (abiValueType x)
+     assertEqual (Text.unpack s)
+       (fmap Bytes (Just (encodeAbiValue x)))
+       (fmap Bytes y)
