├── LICENSE ├── Makefile ├── big.ml ├── compile.sh ├── evm.v ├── extract.v ├── main.ml └── readme.md /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | 474 | Copyright (C) 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 489 | 490 | Also add information on how to contact you by electronic and paper mail. 491 | 492 | You should also get your employer (if you work as a programmer) or your 493 | school, if any, to sign a "copyright disclaimer" for the library, if 494 | necessary. Here is a sample; alter the names: 495 | 496 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 497 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 498 | 499 | , 1 April 1990 500 | Ty Coon, President of Vice 501 | 502 | That's all there is to it! 503 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: clean 2 | 3 | main.native: main.ml compile.sh evm.ml evm.mli big.ml 4 | ./compile.sh 5 | evm.ml evm.mli: extract.v evm.vo Makefile 6 | coqc extract.v 7 | mv List.ml CoqList.ml 8 | mv List.mli CoqList.mli 9 | mv Nat.ml CoqNat.ml 10 | mv Nat.mli CoqNat.mli 11 | sed -i -- 's/List/CoqList/g' evm.ml evm.mli 12 | sed -i -- 's/open Nat/open CoqNat/g' evm.ml 13 | sed -i -- 's/Nat/CoqNat/g' BinPosDef.ml BinPosDef.mli BinPos.ml BinPos.mli 14 | evm.vo: evm.v Makefile 15 | coqc evm.v 16 | 17 | clean: 18 | rm -f Ascii.ml Ascii.mli BinNat.ml BinNat.mli BinNums.ml BinNums.mli BinPos.ml BinPos.mli 19 | rm -f Bool.ml Bool.mli Compare_dec.ml Compare_dec.mli Datatypes.ml Datatypes.mli 20 | rm -f Div2* EqNat* Logic* NPeano* Peano* Specif* String* Nat* CoqNat* main evm.mli evm.vo evm.ml extract.vo extract.glob evm.glob 21 | rm -f BinPosDef* List* CoqList* main.native main.byte .evm.aux .extract.aux 22 | rm -rf _build 23 | rm -f *~ 24 | -------------------------------------------------------------------------------- /big.ml: -------------------------------------------------------------------------------- 1 | (************************************************************************) 2 | (* v * The Coq Proof Assistant / The Coq Development Team *) 3 | (* 0 then fp z else fn (opp z) 137 | 138 | let compare_case e l g x y = 139 | let s = compare x y in if s = 0 then e else if s<0 then l else g 140 | 141 | let nat_rec fO fS = 142 | let rec loop acc n = 143 | if sign n <= 0 then acc else loop (fS acc) (pred n) 144 | in loop fO 145 | 146 | let positive_rec f2p1 f2p f1 = 147 | let rec loop n = 148 | if le n one then f1 149 | else 150 | let (q,r) = quomod n two in 151 | if eq r zero then f2p (loop q) else f2p1 (loop q) 152 | in loop 153 | 154 | let z_rec fO fp fn = z_case (fun _ -> fO) fp fn 155 | -------------------------------------------------------------------------------- /compile.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | ocamlbuild -use-ocamlfind -pkgs batteries,getopt,lwt,cohttp,cohttp.lwt,netstring -cflag -ppopt -cflag -lwt-debug main.native main.byte 3 | -------------------------------------------------------------------------------- /evm.v: -------------------------------------------------------------------------------- 1 | (* Coq 8.5pl2. *) 2 | 3 | Require Import Ascii. 4 | Require Import String. 5 | Require Import List. 6 | Require Import FMapInterface. 7 | Require Import NArith. 8 | 9 | Module Lang. 10 | 11 | (* TODO: sort by opcode *) 12 | Inductive instr := (** partial. adding those necessary. *) 13 | (* 0s *) 14 | | STOP 15 | | ADD 16 | | MUL 17 | | SUB 18 | | DIV 19 | | SDIV 20 | | MOD 21 | | SMOD 22 | | ADDMOD 23 | | MULMOD 24 | | EXP 25 | | SIGNEXTEND 26 | (* 10s *) 27 | | LT 28 | | GT 29 | | SLT 30 | | SGT 31 | | EQ 32 | | ISZERO 33 | | AND 34 | | OR 35 | | XOR 36 | | NOT 37 | | BYTE 38 | (* 20s *) 39 | | SHA3 40 | (* 30s *) 41 | | ADDRESS 42 | | BALANCE 43 | | ORIGIN 44 | | CALLER 45 | | CALLVALUE 46 | | CALLDATALOAD 47 | | CALLDATASIZE 48 | | CALLDATACOPY 49 | | CODESIZE 50 | | CODECOPY 51 | | GASPRICE 52 | | EXTCODESIZE 53 | | EXTCODECOPY 54 | (* 40s *) 55 | | BLOCKHASH 56 | | COINBASE 57 | | TIMESTAMP 58 | | NUMBER 59 | | DIFFICULTY 60 | | GASLIMIT 61 | (* 50s *) 62 | | POP 63 | | MLOAD 64 | | MSTORE 65 | | MSTORE8 66 | | SLOAD 67 | | SSTORE 68 | | JUMP 69 | | JUMPI 70 | | PC 71 | | MSIZE 72 | | GAS 73 | | JUMPDEST 74 | (* 60s, 70s *) 75 | | PUSH_N : (* pushed value in hex with 0x *) string -> instr 76 | (* 80s *) 77 | | DUP1 78 | | DUP2 79 | | DUP3 80 | | DUP4 81 | | DUP5 82 | | DUP6 83 | | DUP7 84 | | DUP8 85 | | DUP9 86 | | DUP10 87 | | DUP11 88 | | DUP12 89 | | DUP13 90 | | DUP14 91 | | DUP15 92 | | DUP16 93 | (* 90s *) 94 | | SWAP1 95 | | SWAP2 96 | | SWAP3 97 | | SWAP4 98 | | SWAP5 99 | | SWAP6 100 | | SWAP7 101 | | SWAP8 102 | | SWAP9 103 | | SWAP10 104 | | SWAP11 105 | | SWAP12 106 | | SWAP13 107 | | SWAP14 108 | | SWAP15 109 | | SWAP16 110 | (* a0s *) 111 | | LOG0 112 | | LOG1 113 | | LOG2 114 | | LOG3 115 | | LOG4 116 | (* f0s *) 117 | | CREATE 118 | | CALL 119 | | CALLCODE 120 | | RETURN 121 | | DELEGATECALL 122 | | SUICIDE 123 | | UNKNOWN : string -> instr 124 | . 125 | 126 | Fixpoint string_half_len str := 127 | match str with 128 | | String _ (String _ tl) => S (string_half_len tl) 129 | | _ => O 130 | end. 131 | 132 | Definition instr_length (i : instr) : nat := 133 | match i with 134 | | PUSH_N str => string_half_len str 135 | | _ => 1 136 | end. 137 | 138 | Require Import Coq.Program.Wf. 139 | 140 | Fixpoint drop_bytes (prog : list instr) (bytes : nat) {struct bytes} := 141 | match prog, bytes with 142 | | _, O => prog 143 | | PUSH_N str :: tl, S pre => 144 | drop_bytes tl (pre - (string_half_len str - 1)) 145 | | _ :: tl, S pre => 146 | drop_bytes tl pre 147 | | nil, S _ => nil 148 | end. 149 | 150 | Open Scope N_scope. 151 | Fixpoint program_bytes (prog : list instr) : N := 152 | match prog with 153 | | nil => 0 154 | | PUSH_N str :: tl => 155 | (N.of_nat (string_half_len str) - 1) + 156 | program_bytes tl 157 | | _ :: tl => 158 | 1 + program_bytes tl 159 | end. 160 | Close Scope N_scope. 161 | 162 | Inductive decoding_mode : Set := 163 | | first_zero 164 | | first_x 165 | | next_instr 166 | | read_0 167 | | read_1 168 | | read_2 169 | | read_3 170 | | read_4 171 | | read_5 172 | | read_6 173 | | read_7 174 | | read_8 175 | | read_9 176 | | read_a 177 | | read_b 178 | | read_c 179 | | read_d 180 | | read_e 181 | | read_f 182 | | read_hex : nat (* remaining read, after the next char *) 183 | -> list ascii (* read so far in reverse *) -> decoding_mode 184 | . 185 | 186 | Inductive decode_result : Set := 187 | | decode_success : list instr -> decode_result 188 | | decode_failure : string -> decode_result 189 | . 190 | 191 | Close Scope string_scope. 192 | Open Scope char_scope. 193 | Definition rev0x : list ascii := "x" :: "0" :: nil. 194 | Fixpoint rev_string_inner (lst : list ascii) (acc : string): string := 195 | match lst with 196 | | nil => acc 197 | | hd :: tl => rev_string_inner tl (String hd acc) 198 | end. 199 | 200 | Definition rev_string lst := rev_string_inner lst EmptyString. 201 | 202 | (* sofar accumulates instructions in the reverse order *) 203 | 204 | Open Scope string_scope. 205 | 206 | Fixpoint decode_inner (str : string) (m : decoding_mode) 207 | (sofar : list instr): decode_result := 208 | let after_0 (error_message : string) := 209 | match str with 210 | | String "0" rest => decode_inner rest next_instr (STOP :: sofar) 211 | | String "1" rest => decode_inner rest next_instr (ADD :: sofar) 212 | | String "2" rest => decode_inner rest next_instr (MUL :: sofar) 213 | | String "3" rest => decode_inner rest next_instr (SUB :: sofar) 214 | | String "4" rest => decode_inner rest next_instr (DIV :: sofar) 215 | | String "5" rest => decode_inner rest next_instr (SDIV :: sofar) 216 | | String "6" rest => decode_inner rest next_instr (MOD :: sofar) 217 | | String "7" rest => decode_inner rest next_instr (SMOD :: sofar) 218 | | String "8" rest => decode_inner rest next_instr (ADDMOD :: sofar) 219 | | String "9" rest => decode_inner rest next_instr (MULMOD :: sofar) 220 | | String "a" rest => decode_inner rest next_instr (EXP :: sofar) 221 | | String "b" rest => decode_inner rest next_instr (SIGNEXTEND :: sofar) 222 | | String "c" rest => decode_inner rest next_instr (UNKNOWN "0c" :: sofar) 223 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "0d" :: sofar) 224 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "0e" :: sofar) 225 | | String "f" rest => decode_inner rest next_instr (UNKNOWN "0f" :: sofar) 226 | | _ => decode_failure error_message 227 | end in 228 | match m with 229 | | first_zero => 230 | match str with 231 | | String "0" rest => decode_inner rest first_x sofar 232 | | String "1" rest => decode_inner rest read_1 sofar 233 | | String "2" rest => decode_inner rest read_2 sofar 234 | | String "3" rest => decode_inner rest read_3 sofar 235 | | String "4" rest => decode_inner rest read_4 sofar 236 | | String "5" rest => decode_inner rest read_5 sofar 237 | | String "6" rest => decode_inner rest read_6 sofar 238 | | String "7" rest => decode_inner rest read_7 sofar 239 | | String "8" rest => decode_inner rest read_8 sofar 240 | | String "9" rest => decode_inner rest read_9 sofar 241 | | String "a" rest => decode_inner rest read_a sofar 242 | | String "b" rest => decode_inner rest read_b sofar 243 | | String "c" rest => decode_inner rest read_c sofar 244 | | String "d" rest => decode_inner rest read_d sofar 245 | | String "e" rest => decode_inner rest read_e sofar 246 | | String "f" rest => decode_inner rest read_f sofar 247 | | _ => decode_failure "first nonzero" 248 | end 249 | | first_x => 250 | match str with 251 | | String "x" rest => decode_inner rest next_instr sofar 252 | (* since we are not reading x, 0 must have been first byte of the code*) 253 | | _ => after_0 "second character not x nor hex digit" 254 | end 255 | | next_instr => 256 | match str with 257 | | String "0" rest => decode_inner rest read_0 sofar 258 | | String "1" rest => decode_inner rest read_1 sofar 259 | | String "2" rest => decode_inner rest read_2 sofar 260 | | String "3" rest => decode_inner rest read_3 sofar 261 | | String "4" rest => decode_inner rest read_4 sofar 262 | | String "5" rest => decode_inner rest read_5 sofar 263 | | String "6" rest => decode_inner rest read_6 sofar 264 | | String "7" rest => decode_inner rest read_7 sofar 265 | | String "8" rest => decode_inner rest read_8 sofar 266 | | String "9" rest => decode_inner rest read_9 sofar 267 | | String "a" rest => decode_inner rest read_a sofar 268 | | String "b" rest => decode_inner rest read_b sofar 269 | | String "c" rest => decode_inner rest read_c sofar 270 | | String "d" rest => decode_inner rest read_d sofar 271 | | String "e" rest => decode_inner rest read_e sofar 272 | | String "f" rest => decode_inner rest read_f sofar 273 | | EmptyString => decode_success (List.rev sofar) 274 | | _ => decode_failure "?" 275 | end 276 | | read_0 => after_0 "0?" 277 | | read_1 => 278 | match str with 279 | | String "0" rest => decode_inner rest next_instr (LT :: sofar) 280 | | String "1" rest => decode_inner rest next_instr (GT :: sofar) 281 | | String "2" rest => decode_inner rest next_instr (SLT :: sofar) 282 | | String "3" rest => decode_inner rest next_instr (SGT :: sofar) 283 | | String "4" rest => decode_inner rest next_instr (EQ :: sofar) 284 | | String "5" rest => decode_inner rest next_instr (ISZERO :: sofar) 285 | | String "6" rest => decode_inner rest next_instr (AND :: sofar) 286 | | String "7" rest => decode_inner rest next_instr (OR :: sofar) 287 | | String "8" rest => decode_inner rest next_instr (XOR :: sofar) 288 | | String "9" rest => decode_inner rest next_instr (NOT :: sofar) 289 | | String "a" rest => decode_inner rest next_instr (BYTE :: sofar) 290 | | String "b" rest => decode_inner rest next_instr (UNKNOWN "1f" :: sofar) 291 | | String "c" rest => decode_inner rest next_instr (UNKNOWN "1f" :: sofar) 292 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "1f" :: sofar) 293 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "1f" :: sofar) 294 | | String "f" rest => decode_inner rest next_instr (UNKNOWN "1f" :: sofar) 295 | | _ => decode_failure "1?" 296 | end 297 | | read_2 => 298 | match str with 299 | | String "0" rest => decode_inner rest next_instr (SHA3 :: sofar) 300 | | String "7" rest => decode_inner rest next_instr (UNKNOWN "27" :: sofar) 301 | | String _ rest => decode_inner rest next_instr (UNKNOWN "2?" :: sofar) 302 | | _ => decode_failure "2$" 303 | end 304 | | read_3 => 305 | match str with 306 | | String "0" rest => decode_inner rest next_instr (ADDRESS :: sofar) 307 | | String "1" rest => decode_inner rest next_instr (BALANCE :: sofar) 308 | | String "2" rest => decode_inner rest next_instr (ORIGIN :: sofar) 309 | | String "3" rest => decode_inner rest next_instr (CALLER :: sofar) 310 | | String "4" rest => decode_inner rest next_instr (CALLVALUE :: sofar) 311 | | String "5" rest => decode_inner rest next_instr (CALLDATALOAD :: sofar) 312 | | String "6" rest => decode_inner rest next_instr (CALLDATASIZE :: sofar) 313 | | String "7" rest => decode_inner rest next_instr (CALLDATACOPY :: sofar) 314 | | String "8" rest => decode_inner rest next_instr (CODESIZE :: sofar) 315 | | String "9" rest => decode_inner rest next_instr (CODECOPY :: sofar) 316 | | String "a" rest => decode_inner rest next_instr (GASPRICE :: sofar) 317 | | String "b" rest => decode_inner rest next_instr (EXTCODESIZE :: sofar) 318 | | String "c" rest => decode_inner rest next_instr (EXTCODECOPY :: sofar) 319 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "3d" :: sofar) 320 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "3e" :: sofar) 321 | | String "f" rest => decode_inner rest next_instr (UNKNOWN "3f" :: sofar) 322 | | _ => decode_failure "3?" 323 | end 324 | | read_4 => 325 | match str with 326 | | String "0" rest => decode_inner rest next_instr (BLOCKHASH :: sofar) 327 | | String "1" rest => decode_inner rest next_instr (COINBASE :: sofar) 328 | | String "2" rest => decode_inner rest next_instr (TIMESTAMP :: sofar) 329 | | String "3" rest => decode_inner rest next_instr (NUMBER :: sofar) 330 | | String "4" rest => decode_inner rest next_instr (DIFFICULTY :: sofar) 331 | | String "5" rest => decode_inner rest next_instr (GASLIMIT :: sofar) 332 | | String "6" rest => decode_inner rest next_instr (UNKNOWN "46" :: sofar) 333 | | String "7" rest => decode_inner rest next_instr (UNKNOWN "47" :: sofar) 334 | | String "8" rest => decode_inner rest next_instr (UNKNOWN "48" :: sofar) 335 | | String "9" rest => decode_inner rest next_instr (UNKNOWN "49" :: sofar) 336 | | String "a" rest => decode_inner rest next_instr (UNKNOWN "4a" :: sofar) 337 | | String "b" rest => decode_inner rest next_instr (UNKNOWN "4b" :: sofar) 338 | | String "c" rest => decode_inner rest next_instr (UNKNOWN "4c" :: sofar) 339 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "4d" :: sofar) 340 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "4e" :: sofar) 341 | | String "f" rest => decode_inner rest next_instr (UNKNOWN "4f" :: sofar) 342 | | _ => decode_failure "4?" 343 | end 344 | | read_5 => 345 | match str with 346 | | String "0" rest => decode_inner rest next_instr (POP :: sofar) 347 | | String "1" rest => decode_inner rest next_instr (MLOAD :: sofar) 348 | | String "2" rest => decode_inner rest next_instr (MSTORE :: sofar) 349 | | String "3" rest => decode_inner rest next_instr (MSTORE8 :: sofar) 350 | | String "4" rest => decode_inner rest next_instr (SLOAD :: sofar) 351 | | String "5" rest => decode_inner rest next_instr (SSTORE :: sofar) 352 | | String "6" rest => decode_inner rest next_instr (JUMP :: sofar) 353 | | String "7" rest => decode_inner rest next_instr (JUMPI :: sofar) 354 | | String "8" rest => decode_inner rest next_instr (PC :: sofar) 355 | | String "9" rest => decode_inner rest next_instr (MSIZE :: sofar) 356 | | String "a" rest => decode_inner rest next_instr (GAS :: sofar) 357 | | String "b" rest => decode_inner rest next_instr (JUMPDEST :: sofar) 358 | | String "c" rest => decode_inner rest next_instr (UNKNOWN "5c" :: sofar) 359 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "5d" :: sofar) 360 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "5e" :: sofar) 361 | | String "f" rest => decode_inner rest next_instr (UNKNOWN "5f" :: sofar) 362 | | _ => decode_failure "5?" 363 | end 364 | | read_6 => 365 | match str with 366 | | String "0" rest => decode_inner rest (read_hex 2 rev0x) sofar 367 | | String "1" rest => decode_inner rest (read_hex 4 rev0x) sofar 368 | | String "2" rest => decode_inner rest (read_hex 6 rev0x) sofar 369 | | String "3" rest => decode_inner rest (read_hex 8 rev0x) sofar 370 | | String "4" rest => decode_inner rest (read_hex 10 rev0x) sofar 371 | | String "5" rest => decode_inner rest (read_hex 12 rev0x) sofar 372 | | String "6" rest => decode_inner rest (read_hex 14 rev0x) sofar 373 | | String "7" rest => decode_inner rest (read_hex 16 rev0x) sofar 374 | | String "8" rest => decode_inner rest (read_hex 18 rev0x) sofar 375 | | String "9" rest => decode_inner rest (read_hex 20 rev0x) sofar 376 | | String "a" rest => decode_inner rest (read_hex 22 rev0x) sofar 377 | | String "b" rest => decode_inner rest (read_hex 24 rev0x) sofar 378 | | String "c" rest => decode_inner rest (read_hex 26 rev0x) sofar 379 | | String "d" rest => decode_inner rest (read_hex 28 rev0x) sofar 380 | | String "e" rest => decode_inner rest (read_hex 30 rev0x) sofar 381 | | String "f" rest => decode_inner rest (read_hex 32 rev0x) sofar 382 | | _ => decode_failure "6?" 383 | end 384 | | read_7 => 385 | match str with 386 | | String "0" rest => decode_inner rest (read_hex 34 rev0x) sofar 387 | | String "1" rest => decode_inner rest (read_hex 36 rev0x) sofar 388 | | String "2" rest => decode_inner rest (read_hex 38 rev0x) sofar 389 | | String "3" rest => decode_inner rest (read_hex 40 rev0x) sofar 390 | | String "4" rest => decode_inner rest (read_hex 42 rev0x) sofar 391 | | String "5" rest => decode_inner rest (read_hex 44 rev0x) sofar 392 | | String "6" rest => decode_inner rest (read_hex 46 rev0x) sofar 393 | | String "7" rest => decode_inner rest (read_hex 48 rev0x) sofar 394 | | String "8" rest => decode_inner rest (read_hex 50 rev0x) sofar 395 | | String "9" rest => decode_inner rest (read_hex 52 rev0x) sofar 396 | | String "a" rest => decode_inner rest (read_hex 54 rev0x) sofar 397 | | String "b" rest => decode_inner rest (read_hex 56 rev0x) sofar 398 | | String "c" rest => decode_inner rest (read_hex 58 rev0x) sofar 399 | | String "d" rest => decode_inner rest (read_hex 60 rev0x) sofar 400 | | String "e" rest => decode_inner rest (read_hex 62 rev0x) sofar 401 | | String "f" rest => decode_inner rest (read_hex 64 rev0x) sofar 402 | | _ => decode_failure "7?" 403 | end 404 | | read_8 => 405 | match str with 406 | | String "0" rest => decode_inner rest next_instr (DUP1 :: sofar) 407 | | String "1" rest => decode_inner rest next_instr (DUP2 :: sofar) 408 | | String "2" rest => decode_inner rest next_instr (DUP3 :: sofar) 409 | | String "3" rest => decode_inner rest next_instr (DUP4 :: sofar) 410 | | String "4" rest => decode_inner rest next_instr (DUP5 :: sofar) 411 | | String "5" rest => decode_inner rest next_instr (DUP6 :: sofar) 412 | | String "6" rest => decode_inner rest next_instr (DUP7 :: sofar) 413 | | String "7" rest => decode_inner rest next_instr (DUP8 :: sofar) 414 | | String "8" rest => decode_inner rest next_instr (DUP9 :: sofar) 415 | | String "9" rest => decode_inner rest next_instr (DUP10 :: sofar) 416 | | String "a" rest => decode_inner rest next_instr (DUP11 :: sofar) 417 | | String "b" rest => decode_inner rest next_instr (DUP12 :: sofar) 418 | | String "c" rest => decode_inner rest next_instr (DUP13 :: sofar) 419 | | String "d" rest => decode_inner rest next_instr (DUP14 :: sofar) 420 | | String "e" rest => decode_inner rest next_instr (DUP15 :: sofar) 421 | | String "f" rest => decode_inner rest next_instr (DUP16 :: sofar) 422 | | _ => decode_failure "8?" 423 | end 424 | | read_9 => 425 | match str with 426 | | String "0" rest => decode_inner rest next_instr (SWAP1 :: sofar) 427 | | String "1" rest => decode_inner rest next_instr (SWAP2 :: sofar) 428 | | String "2" rest => decode_inner rest next_instr (SWAP3 :: sofar) 429 | | String "3" rest => decode_inner rest next_instr (SWAP4 :: sofar) 430 | | String "4" rest => decode_inner rest next_instr (SWAP5 :: sofar) 431 | | String "5" rest => decode_inner rest next_instr (SWAP6 :: sofar) 432 | | String "6" rest => decode_inner rest next_instr (SWAP7 :: sofar) 433 | | String "7" rest => decode_inner rest next_instr (SWAP8 :: sofar) 434 | | String "8" rest => decode_inner rest next_instr (SWAP9 :: sofar) 435 | | String "9" rest => decode_inner rest next_instr (SWAP10 :: sofar) 436 | | String "a" rest => decode_inner rest next_instr (SWAP11 :: sofar) 437 | | String "b" rest => decode_inner rest next_instr (SWAP12 :: sofar) 438 | | String "c" rest => decode_inner rest next_instr (SWAP13 :: sofar) 439 | | String "d" rest => decode_inner rest next_instr (SWAP14 :: sofar) 440 | | String "e" rest => decode_inner rest next_instr (SWAP15 :: sofar) 441 | | String "f" rest => decode_inner rest next_instr (SWAP16 :: sofar) 442 | | _ => decode_failure "9?" 443 | end 444 | | read_a => 445 | match str with 446 | | String "0" rest => decode_inner rest next_instr (LOG0 :: sofar) 447 | | String "1" rest => decode_inner rest next_instr (LOG1 :: sofar) 448 | | String "2" rest => decode_inner rest next_instr (LOG2 :: sofar) 449 | | String "3" rest => decode_inner rest next_instr (LOG3 :: sofar) 450 | | String "4" rest => decode_inner rest next_instr (LOG4 :: sofar) 451 | | String "5" rest => decode_inner rest next_instr (UNKNOWN "a5" :: sofar) 452 | | String "6" rest => decode_inner rest next_instr (UNKNOWN "a6" :: sofar) 453 | | String "7" rest => decode_inner rest next_instr (UNKNOWN "a7" :: sofar) 454 | | String "8" rest => decode_inner rest next_instr (UNKNOWN "a8" :: sofar) 455 | | String "9" rest => decode_inner rest next_instr (UNKNOWN "a9" :: sofar) 456 | | String "a" rest => decode_inner rest next_instr (UNKNOWN "aa" :: sofar) 457 | | String "b" rest => decode_inner rest next_instr (UNKNOWN "ab" :: sofar) 458 | | String "c" rest => decode_inner rest next_instr (UNKNOWN "ac" :: sofar) 459 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "ad" :: sofar) 460 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "ae" :: sofar) 461 | | String "f" rest => decode_inner rest next_instr (UNKNOWN "af" :: sofar) 462 | | _ => decode_failure "a?" 463 | end 464 | | read_b => 465 | match str with 466 | | String _ rest => decode_inner rest next_instr (UNKNOWN "b?" :: sofar) 467 | | EmptyString => decode_failure "b?" 468 | end 469 | | read_c => 470 | match str with 471 | | String _ rest => decode_inner rest next_instr (UNKNOWN "c?" :: sofar) 472 | | EmptyString => decode_failure "c?" 473 | end 474 | | read_d => 475 | match str with 476 | | String _ rest => decode_inner rest next_instr (UNKNOWN "d?" :: sofar) 477 | | EmptyString => decode_failure "d?" 478 | end 479 | | read_e => 480 | match str with 481 | | String "0" rest => decode_inner rest next_instr (UNKNOWN "e0" :: sofar) 482 | | String "9" rest => decode_inner rest next_instr (UNKNOWN "e9" :: sofar) 483 | | String _ rest => decode_inner rest next_instr (UNKNOWN "e?" :: sofar) 484 | | EmptyString => decode_failure "e?" 485 | end 486 | | read_f => 487 | match str with 488 | | String "0" rest => decode_inner rest next_instr (CREATE :: sofar) 489 | | String "1" rest => decode_inner rest next_instr (CALL :: sofar) 490 | | String "2" rest => decode_inner rest next_instr (CALLCODE :: sofar) 491 | | String "3" rest => decode_inner rest next_instr (RETURN :: sofar) 492 | | String "4" rest => decode_inner rest next_instr (UNKNOWN "f4" :: sofar) 493 | | String "5" rest => decode_inner rest next_instr (UNKNOWN "f5" :: sofar) 494 | | String "6" rest => decode_inner rest next_instr (UNKNOWN "f6" :: sofar) 495 | | String "7" rest => decode_inner rest next_instr (UNKNOWN "f7" :: sofar) 496 | | String "8" rest => decode_inner rest next_instr (UNKNOWN "f8" :: sofar) 497 | | String "9" rest => decode_inner rest next_instr (UNKNOWN "f9" :: sofar) 498 | | String "a" rest => decode_inner rest next_instr (UNKNOWN "fa" :: sofar) 499 | | String "b" rest => decode_inner rest next_instr (UNKNOWN "fb" :: sofar) 500 | | String "c" rest => decode_inner rest next_instr (UNKNOWN "fc" :: sofar) 501 | | String "d" rest => decode_inner rest next_instr (UNKNOWN "fd" :: sofar) 502 | | String "e" rest => decode_inner rest next_instr (UNKNOWN "fe" :: sofar) 503 | | String "f" rest => decode_inner rest next_instr (SUICIDE :: sofar) 504 | | _ => decode_failure "f?" 505 | end 506 | | read_hex O acc => decode_failure "should not happen" 507 | | read_hex (S O) acc => 508 | match str with 509 | | EmptyString => decode_success (List.rev sofar) (*decode_failure "end_of_string reading hex" *) 510 | | String c rest => 511 | decode_inner rest next_instr (PUSH_N (rev_string (c :: acc)) :: sofar) 512 | end 513 | | read_hex (S pre) acc => 514 | match str with 515 | | EmptyString => decode_success (List.rev sofar) (* decode_failure "end_of_string reading hex" *) 516 | | String c rest => 517 | decode_inner rest (read_hex pre (c :: acc)) sofar 518 | end 519 | end 520 | . 521 | (* Question: Is there a need to decode further after a failure *) 522 | 523 | Definition decode (code : string) : decode_result := 524 | decode_inner code first_zero nil. 525 | 526 | Open Scope string_scope. 527 | 528 | 529 | Open Scope char_scope. 530 | Close Scope nat_scope. 531 | Open Scope N_scope. 532 | 533 | Definition read_hex_char (c : ascii) : option N := 534 | match c with 535 | | "0" => Some 0 536 | | "1" => Some 1 537 | | "2" => Some 2 538 | | "3" => Some 3 539 | | "4" => Some 4 540 | | "5" => Some 5 541 | | "6" => Some 6 542 | | "7" => Some 7 543 | | "8" => Some 8 544 | | "9" => Some 9 545 | | "a" => Some 10 546 | | "b" => Some 11 547 | | "c" => Some 12 548 | | "d" => Some 13 549 | | "e" => Some 14 550 | | "f" => Some 15 551 | | _ => None 552 | end. 553 | 554 | Fixpoint read_str_hex (carry: N) (str : string) : N := 555 | match str with 556 | | EmptyString => carry 557 | | String c rest => 558 | match read_hex_char c with 559 | | None => 0 560 | | Some num => read_str_hex (carry * 16 + num) rest 561 | end 562 | end. 563 | 564 | Definition literal_to_nat (str : string) : N := 565 | match str with 566 | | String "0" (String "x" rest) => read_str_hex 0 rest 567 | | _ => 0 568 | end. 569 | 570 | 571 | End Lang. 572 | 573 | 574 | Module AbstractEVM. 575 | 576 | Definition a_pc := N. (* program counter *) 577 | Definition a_hex := string. 578 | 579 | (* a_word stands for abstract world *) 580 | Inductive a_word := 581 | | Acaller : a_word 582 | | Aorigin : a_word 583 | | Agas_price : a_word 584 | | Ablock_number : a_word 585 | | Acoinbase : a_word 586 | | Ablockhash : a_word 587 | | Atime : a_word 588 | | Adatasize : a_word 589 | | Avalue : a_word 590 | | Aaddress : a_word 591 | | Abalance : a_word -> a_word 592 | | Adifficulty : a_word 593 | | Agaslimit : a_word 594 | | Aextcodesize : a_word -> a_word 595 | | Aimm_nat : N -> a_word 596 | | Aunknown : string -> a_word (* whatever that might change during execution *) 597 | | Ais_zero : a_word -> a_word 598 | | Azero : a_word 599 | | Asub : a_word -> a_word -> a_word 600 | | Aadd : a_word -> a_word -> a_word 601 | | Aand : a_word -> a_word -> a_word 602 | | Abyte : a_word -> a_word -> a_word 603 | | Aor : a_word -> a_word -> a_word 604 | | Axor : a_word -> a_word -> a_word 605 | | Aexp : a_word -> a_word -> a_word 606 | | Adiv : a_word -> a_word -> a_word 607 | | Amul : a_word -> a_word -> a_word 608 | | Agt : a_word -> a_word -> a_word 609 | | Asdiv : a_word -> a_word -> a_word 610 | | Amod : a_word -> a_word -> a_word 611 | | Asmod : a_word -> a_word -> a_word 612 | | Asignextend : a_word -> a_word -> a_word 613 | | Anot : a_word -> a_word 614 | | Asha3 : a_memory -> a_word 615 | | Alt : a_word -> a_word -> a_word 616 | | Aslt : a_word -> a_word -> a_word 617 | | Aeq : a_word -> a_word -> a_word 618 | | Aget32 : a_word -> a_memory -> a_word (* Aget32 addr mem *) 619 | | Aget_storage : a_word -> a_storage -> a_word 620 | with a_memory := 621 | | Aempty : a_memory 622 | | Aput32 : a_word -> a_word -> a_memory -> a_memory 623 | (* Aput32 addr val orig represents the result of a one-word write. *) 624 | | Aput1 : a_word -> a_word -> a_memory -> a_memory 625 | (* Aput1 addr val orig represents the result of a one-byte write. 626 | * Actually (val mod 256) is written. 627 | *) 628 | | Amemwrite : a_word -> a_word -> a_memory -> a_memory -> a_memory 629 | (* Amemwrite start_addr len source mem represents the result of memwrite. source [0..len - 1] is copied to mem[start_addr.. start_addr + len - 1]. *) 630 | | Adata : a_memory 631 | (* Adata represents the input data. *) 632 | | Adrop : a_word -> a_memory -> a_memory 633 | (* Adrop n mem is the result of dropping the first n bytes and shifting forward. *) 634 | | Atake : a_word -> a_word -> a_memory -> a_memory 635 | (* Atake n size mem takes size bytes from position n *) 636 | | Acodecopy : a_word -> a_word -> a_word -> a_memory -> a_memory 637 | (* Acodecopy base_in_memory base_in_code len orig *) 638 | | Amem_imm : string -> a_memory 639 | | Aconcat : a_word -> a_word -> a_memory 640 | (* Aconcat w0 w1 appears a lot in Solidity compilation. *) 641 | with a_storage := 642 | | Ainitial_storage : a_storage 643 | | Aput_storage : a_word -> a_word -> a_storage -> a_storage 644 | . 645 | 646 | Fixpoint simplify_above (addr : N) (mem : a_memory) := 647 | match mem with 648 | | Aput32 (Aimm_nat w) val orig => 649 | if N.leb addr w then simplify_above addr orig 650 | else 651 | Aput32 (Aimm_nat w) val (simplify_above addr orig) 652 | | _ => mem 653 | end. 654 | 655 | Fixpoint simplify_below (addr : N) (mem : a_memory) := 656 | match mem with 657 | | Aput32 (Aimm_nat w) val orig => 658 | if N.leb (w + 32) addr then simplify_below addr orig 659 | else 660 | Aput32 (Aimm_nat w) val (simplify_below addr orig) 661 | | _ => mem 662 | end. 663 | 664 | Definition Atake' start size mem := 665 | match start, size, mem with 666 | | Aimm_nat 0, Aimm_nat 64, (Aput32 (Aimm_nat 32) y (Aput32 (Aimm_nat 0) x _)) => 667 | Aconcat x y 668 | | Aimm_nat 0, Aimm_nat 64, (Aput32 (Aimm_nat 0) x (Aput32 (Aimm_nat 32) y _)) => 669 | Aconcat x y 670 | | Aimm_nat st, Aimm_nat si, _ => 671 | Atake start size 672 | (simplify_below st (simplify_above (st + si) mem)) 673 | | _, _, _ => 674 | Atake start size mem 675 | end. 676 | 677 | Fixpoint Aget_storage' (index : a_word) (str : a_storage) : a_word := 678 | match index, str with 679 | | _, Ainitial_storage => Aget_storage index str 680 | | Aimm_nat i, Aput_storage (Aimm_nat j) x orig => 681 | if N.eqb i j then x else 682 | Aget_storage' (Aimm_nat i) orig 683 | | _, _ => Aget_storage index str 684 | end. 685 | 686 | Definition Aadd' (a : a_word) (b : a_word) := 687 | match a, b with 688 | | Aimm_nat m, Aimm_nat n => Aimm_nat (m + n) 689 | | _, Azero => a 690 | | Azero, _ => b 691 | | _, _ => Aadd a b 692 | end. 693 | 694 | Definition Asub' (a : a_word) (b : a_word) := 695 | match a, b with 696 | | Aimm_nat m, Aimm_nat n => 697 | if (N.leb n m) then Aimm_nat (m - n) else Asub a b 698 | | _, _ => Asub a b 699 | end. 700 | 701 | Definition Aexp' (a : a_word) (b : a_word) := 702 | match a, b with 703 | | Aimm_nat m, Aimm_nat n => Aimm_nat (N.pow m n) 704 | | _, _ => Aexp a b 705 | end. 706 | 707 | Close Scope nat_scope. 708 | 709 | Fixpoint Aget32' (addr : a_word) (mem : a_memory) : a_word := 710 | match addr, mem with 711 | | Aimm_nat n, Aput32 (Aimm_nat w) v orig => 712 | if orb (N.leb 32 (n - w)) (N.leb 32 (w - n)) then 713 | Aget32' addr orig 714 | else if (N.eqb n w) then v else Aget32 addr mem 715 | | _, Aempty => Azero 716 | | Aimm_nat n, Acodecopy (Aimm_nat mem_start) _ (Aimm_nat size) orig => 717 | if N.leb (n + 32) mem_start then 718 | Aget32' addr orig 719 | else if N.leb (mem_start + size) n then 720 | Aget32' addr orig 721 | else 722 | Aget32 addr mem 723 | | _, _ => Aget32 addr mem 724 | end. 725 | 726 | Fixpoint forget32 addr orig := 727 | match addr, orig with 728 | | Aimm_nat w, Aput32 (Aimm_nat p) v pre => 729 | if (N.eqb w p) then 730 | forget32 addr pre 731 | else 732 | Aput32 (Aimm_nat p) v (forget32 addr pre) 733 | | _, _ => orig 734 | end. 735 | 736 | Fixpoint Aput32' (addr : a_word) (val : a_word) (orig : a_memory) : a_memory := 737 | Aput32 addr val (forget32 addr orig). 738 | 739 | Definition Aimm (hex : a_hex) : a_word := 740 | Aimm_nat (Lang.literal_to_nat hex). 741 | 742 | Definition a_stack := list a_word. 743 | 744 | Inductive a_prop := 745 | | is_zero : a_word -> a_prop 746 | | is_not_zero : a_word -> a_prop 747 | . 748 | 749 | Definition a_operation := a_stack -> a_memory -> 750 | list (list a_prop * option (a_stack * a_memory)). 751 | 752 | (* [ (condition1, None = failure ); (condition2, Some (post_stack, post_memory)) ] *) 753 | 754 | Require Import List. 755 | Open Scope N_scope. 756 | 757 | Definition simple_result {T} (x : T) := (@nil a_prop, x) :: nil. 758 | 759 | Definition a_push_x (data : a_word) : a_operation := 760 | fun s mem => simple_result (Some (data :: s, mem)). 761 | 762 | Definition a_pop : a_operation := 763 | fun s mem => 764 | match s with 765 | | nil => simple_result None 766 | | hd :: tl => simple_result (Some (tl, mem)) 767 | end. 768 | 769 | Definition a_mstore : a_operation := 770 | fun s mem => 771 | match s with 772 | | nil => simple_result None 773 | | _ :: nil => simple_result None 774 | | a :: b :: l => simple_result (Some (l, Aput32' a b mem)) 775 | end. 776 | 777 | (* TODO: use Aput1' instead of Aput1. See Aput32'. *) 778 | Definition a_mstore8 : a_operation := 779 | fun s mem => 780 | match s with 781 | | nil => simple_result None 782 | | _ :: nil => simple_result None 783 | | a :: b :: l => simple_result (Some (l, Aput1 a b mem)) 784 | end. 785 | 786 | Definition a_mload : a_operation := 787 | fun s mem => 788 | simple_result 789 | match s with 790 | | nil => None 791 | | addr :: l => 792 | Some (Aget32' addr mem :: l, mem) 793 | end. 794 | 795 | Definition a_gas : a_operation := 796 | fun s mem => 797 | simple_result (Some (Aunknown "remaining gas" :: s, mem)). 798 | 799 | Definition a_msize : a_operation := 800 | fun s mem => 801 | simple_result (Some (Aunknown "memory size" :: s, mem)). 802 | 803 | Definition a_calldatasize : a_operation := 804 | fun s mem => 805 | simple_result (Some (Adatasize :: s, mem)). 806 | 807 | Definition a_callvalue : a_operation := 808 | fun s mem => 809 | simple_result (Some (Avalue :: s, mem)). 810 | Definition a_address : a_operation := 811 | fun s mem => 812 | simple_result (Some (Aaddress :: s, mem)). 813 | Definition a_one_one_op (f : a_word -> a_word) : a_operation := 814 | fun s mem => 815 | simple_result 816 | match s with 817 | | nil => None 818 | | a :: l => Some (f a :: l, mem) 819 | end. 820 | 821 | Definition a_balance : a_operation := a_one_one_op Abalance. 822 | 823 | Definition a_calldatacopy : a_operation := 824 | fun s mem => 825 | simple_result 826 | match s with 827 | | m0 :: m1 :: m2 :: l => 828 | Some (l, Amemwrite m0 m2 (Adrop m1 Adata) mem) 829 | | _ => None 830 | end. 831 | 832 | Definition a_codecopy : a_operation := 833 | fun s mem => 834 | simple_result 835 | match s with 836 | | m0 :: m1 :: m2 :: l => 837 | Some (l, Acodecopy m0 m1 m2 mem) 838 | | _ => None 839 | end. 840 | 841 | Definition Ais_zero' (orig : a_word) : a_word := 842 | match orig with 843 | | Atime => Aimm_nat 0 844 | | Azero => Aimm_nat 1 845 | | Aimm_nat x => 846 | Aimm_nat (if Neqb 0 x then 1 else 0) 847 | | _ => Ais_zero orig 848 | end. 849 | 850 | Definition a_iszero : a_operation := 851 | fun s mem => 852 | simple_result 853 | match s with 854 | | nil => None 855 | | h :: tl => 856 | Some (Ais_zero' h :: tl, mem) 857 | end. 858 | 859 | Definition a_two_two_op (f : a_word -> a_word -> (a_word * a_word)) : a_operation := 860 | fun s mem => 861 | simple_result 862 | match s with 863 | | a :: b :: l => 864 | Some (fst (f a b) :: snd (f a b) :: l, mem) 865 | | _ => None 866 | end. 867 | 868 | Definition a_two_one_op (f : a_word -> a_word -> a_word) : a_operation := 869 | fun s mem => 870 | simple_result 871 | match s with 872 | | nil => None 873 | | _ :: nil => None 874 | | a :: b :: l => Some ((f a b) :: l, mem) 875 | end. 876 | 877 | Definition a_three_one_op (f : a_word -> a_word -> a_word -> a_word) 878 | : a_operation := 879 | fun s mem => 880 | simple_result 881 | match s with 882 | | nil => None 883 | | _ :: nil => None 884 | | _ :: _ :: nil => None 885 | | a :: b :: c :: l => Some ((f a b c) :: l, mem) 886 | end. 887 | 888 | Definition a_exp_op : a_operation := a_two_one_op Aexp'. 889 | 890 | Definition a_and_op : a_operation := a_two_one_op Aand. 891 | Definition a_or_op : a_operation := a_two_one_op Aor. 892 | Definition a_byte_op : a_operation := a_two_one_op Abyte. 893 | Definition a_xor_op : a_operation := a_two_one_op Axor. 894 | 895 | Definition a_sload storage : a_operation := 896 | a_one_one_op (fun addr => Aget_storage' addr storage). 897 | 898 | Definition a_calldataload : a_operation := 899 | a_one_one_op (fun n => Aget32' n Adata). 900 | 901 | Definition a_div_op := a_two_one_op Adiv. 902 | Definition a_mul_op := a_two_one_op Amul. 903 | Definition a_add_op := a_two_one_op Aadd'. 904 | Definition a_sdiv_op := a_two_one_op Asdiv. 905 | Definition a_mod_op := a_two_one_op Amod. 906 | Definition a_addmod_op := a_three_one_op 907 | (fun a b c => 908 | Amod (Aadd' a b) c). 909 | Definition a_mulmod_op := a_three_one_op 910 | (fun a b c => 911 | Amod (Amul a b) c). 912 | Definition a_smod_op := a_two_one_op Asmod. 913 | Definition a_signextend_op := a_two_one_op Asignextend. 914 | 915 | Definition a_dup1 : a_operation := 916 | fun s mem => 917 | simple_result 918 | match s with 919 | | a :: l => Some (a :: a :: l, mem) 920 | | _ => None (* really? *) 921 | end. 922 | 923 | Definition a_dup2 : a_operation := 924 | fun s mem => 925 | simple_result 926 | match s with 927 | | a :: b :: l => Some (b :: a :: b :: l, mem) 928 | | _ => None 929 | end. 930 | 931 | Definition a_dup3 : a_operation := 932 | fun s mem => 933 | simple_result 934 | match s with 935 | | a :: b :: c :: l => Some (c :: a :: b :: c :: l, mem) 936 | | _ => None 937 | end. 938 | 939 | Definition a_dup4 : a_operation := 940 | fun s mem => 941 | simple_result 942 | match s with 943 | | a :: b :: c :: d :: l => Some (d :: a :: b :: c :: d :: l, mem) 944 | | _ => None 945 | end. 946 | 947 | Fixpoint nth_opt {A} (n : nat) (lst : list A) := 948 | match n, lst with 949 | | S O, hd :: _ => Some hd 950 | | S pre, _ :: tl => nth_opt pre tl 951 | | _, _ => None 952 | end. 953 | 954 | Definition stack_dup n (s : a_stack) := 955 | match nth_opt n s with 956 | | Some elm => Some (elm :: s) 957 | | None => None 958 | end. 959 | 960 | 961 | Definition a_dup_n (n : nat) : a_operation := 962 | fun s mem => 963 | simple_result 964 | match stack_dup n s with 965 | | Some new_s => Some (new_s, mem) 966 | | None => None 967 | end. 968 | 969 | Definition a_eq_op : a_operation := a_two_one_op 970 | (fun a b => Aeq a b). 971 | 972 | Definition a_gt_op : a_operation := a_two_one_op 973 | (fun a b => Agt a b). 974 | 975 | Definition a_slt_op : a_operation := a_two_one_op Aslt. 976 | Definition a_sgt_op : a_operation := 977 | a_two_one_op (fun a b => Aslt b a). 978 | 979 | Definition a_not_op : a_operation := a_one_one_op Anot. 980 | Definition a_extcodesize : a_operation := a_one_one_op Aextcodesize. 981 | 982 | Definition a_sha3 : a_operation := 983 | fun s mem => 984 | simple_result 985 | match s with 986 | | st :: size :: rest => 987 | Some (Asha3 (Atake' st size mem) :: rest, mem) 988 | | _ => None 989 | end. 990 | 991 | Definition a_lt_op : a_operation := a_two_one_op 992 | (fun a b => Alt a b). 993 | 994 | Definition a_sub_op : a_operation := a_two_one_op Asub'. 995 | 996 | Definition a_swap1 : a_operation := a_two_two_op (fun a b => (b, a)). 997 | 998 | Definition a_swap2 : a_operation := 999 | fun s mem => 1000 | simple_result 1001 | match s with 1002 | | a :: b :: c :: l => 1003 | Some (c :: b :: a :: l, mem) 1004 | | _ => None 1005 | end. 1006 | 1007 | Definition a_swap3 : a_operation := 1008 | fun s mem => 1009 | simple_result 1010 | match s with 1011 | | a :: b :: c :: d :: l => 1012 | Some (d :: b :: c :: a :: l, mem) 1013 | | _ => None 1014 | end. 1015 | 1016 | Definition a_swap4 : a_operation := 1017 | fun s mem => 1018 | simple_result 1019 | match s with 1020 | | a :: b :: c :: d :: e :: l => 1021 | Some (e :: b :: c :: d :: a :: l, mem) 1022 | | _ => None 1023 | end. 1024 | 1025 | Definition a_swap5 : a_operation := 1026 | fun s mem => 1027 | simple_result 1028 | match s with 1029 | | a :: b :: c :: d :: e :: f :: l => 1030 | Some (f :: b :: c :: d :: e :: a :: l, mem) 1031 | | _ => None 1032 | end. 1033 | 1034 | Definition a_swap6 : a_operation := 1035 | fun s mem => 1036 | simple_result 1037 | match s with 1038 | | a :: b :: c :: d :: e :: f :: g :: l => 1039 | Some (g :: b :: c :: d :: e :: f :: a :: l, mem) 1040 | | _ => None 1041 | end. 1042 | 1043 | Definition a_swap7 : a_operation := 1044 | fun s mem => 1045 | simple_result 1046 | match s with 1047 | | a :: b :: c :: d :: e :: f :: g :: h :: l => 1048 | Some (h :: b :: c :: d :: e :: f :: g :: a :: l, mem) 1049 | | _ => None 1050 | end. 1051 | 1052 | Definition a_swap8 : a_operation := 1053 | fun s mem => 1054 | simple_result 1055 | match s with 1056 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: l => 1057 | Some (i :: b :: c :: d :: e :: f :: g :: h :: a :: l, mem) 1058 | | _ => None 1059 | end. 1060 | 1061 | Definition a_swap9 : a_operation := 1062 | fun s mem => 1063 | simple_result 1064 | match s with 1065 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: l => 1066 | Some (j :: b :: c :: d :: e :: f :: g :: h :: i :: a :: l, mem) 1067 | | _ => None 1068 | end. 1069 | 1070 | Definition a_swap10 : a_operation := 1071 | fun s mem => 1072 | simple_result 1073 | match s with 1074 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l => 1075 | Some (k :: b :: c :: d :: e :: f :: g :: h :: i :: j :: a :: l, mem) 1076 | | _ => None 1077 | end. 1078 | 1079 | Definition a_swap11 : a_operation := 1080 | fun s mem => 1081 | simple_result 1082 | match s with 1083 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m => 1084 | Some (l :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: a :: m, mem) 1085 | | _ => None 1086 | end. 1087 | 1088 | Definition a_swap12 : a_operation := 1089 | fun s mem => 1090 | simple_result 1091 | match s with 1092 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: X :: rest => 1093 | Some (X :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: a :: rest, mem) 1094 | | _ => None 1095 | end. 1096 | 1097 | Definition a_swap13 : a_operation := 1098 | fun s mem => 1099 | simple_result 1100 | match s with 1101 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: X :: rest => 1102 | Some (X :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: a :: rest, mem) 1103 | | _ => None 1104 | end. 1105 | 1106 | Definition a_swap14 : a_operation := 1107 | fun s mem => 1108 | simple_result 1109 | match s with 1110 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: n :: X :: rest => 1111 | Some (X :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: n :: a :: rest, mem) 1112 | | _ => None 1113 | end. 1114 | 1115 | Definition a_swap15 : a_operation := 1116 | fun s mem => 1117 | simple_result 1118 | match s with 1119 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: n :: o :: X :: rest => 1120 | Some (X :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: n :: o :: a :: rest, mem) 1121 | | _ => None 1122 | end. 1123 | 1124 | Definition a_swap16 : a_operation := 1125 | fun s mem => 1126 | simple_result 1127 | match s with 1128 | | a :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: n :: o :: p :: X :: rest => 1129 | Some (X :: b :: c :: d :: e :: f :: g :: h :: i :: j :: k :: l :: m :: n :: o :: p :: a :: rest, mem) 1130 | | _ => None 1131 | end. 1132 | 1133 | Record a_log_entry := 1134 | { a_log_address : a_word 1135 | ; a_log_topics : list a_word 1136 | ; a_log_data : a_memory 1137 | }. 1138 | 1139 | Definition a_logs := list a_log_entry. 1140 | 1141 | Record a_state := 1142 | { a_stc : a_stack 1143 | ; a_mem : a_memory 1144 | ; a_str : a_storage 1145 | ; a_log : a_logs 1146 | ; a_prg_sfx : list Lang.instr 1147 | ; a_program : list Lang.instr 1148 | ; a_program_code : string 1149 | ; last_instruction : Lang.instr 1150 | }. 1151 | 1152 | Definition update_last_instruction (s : a_state) (i : Lang.instr) := 1153 | {| 1154 | a_stc := s.(a_stc); 1155 | a_mem := s.(a_mem); 1156 | a_str := s.(a_str); 1157 | a_log := s.(a_log); 1158 | a_prg_sfx := s.(a_prg_sfx); 1159 | a_program := s.(a_program); 1160 | a_program_code := s.(a_program_code); 1161 | last_instruction := i 1162 | |}. 1163 | 1164 | Record a_call := 1165 | { a_call_gaslimit : a_word 1166 | ; a_caller : a_word 1167 | ; a_call_code : a_word 1168 | ; a_call_recipient : a_word 1169 | ; a_call_value : a_word 1170 | ; a_call_data_begin : a_word 1171 | ; a_call_data_size : a_word 1172 | ; a_call_output_dst : a_word 1173 | ; a_call_output_max : a_word 1174 | ; a_call_pre : a_state 1175 | }. 1176 | 1177 | Record a_create := 1178 | { a_create_value : a_word 1179 | ; a_create_mem_start : a_word 1180 | ; a_create_mem_size : a_word 1181 | }. 1182 | 1183 | Record a_extcode_copy := 1184 | { a_extcode_copy_addr : a_word 1185 | ; a_extcode_copy_memory_start : a_word 1186 | ; a_extcode_copy_code_start : a_word 1187 | ; a_extcode_copy_len : a_word 1188 | }. 1189 | 1190 | Inductive a_single_result := 1191 | | continue : a_state -> a_single_result 1192 | | suicide : a_word (* who gets the balance *) -> a_single_result 1193 | | returned : a_memory (* output *) -> a_state -> a_single_result 1194 | | stopped : a_state -> a_single_result 1195 | | calling : a_call -> a_single_result 1196 | | creating : a_create -> a_single_result 1197 | | extcode_copying : a_extcode_copy -> a_single_result 1198 | | end_of_program : a_state -> a_single_result (* what actually happens? *) 1199 | | failure : a_state -> a_single_result (* what actually happens? *) 1200 | | not_implemented : Lang.instr -> a_state -> a_single_result 1201 | | decode_fail : string -> a_single_result 1202 | | back_jmp : a_state -> a_single_result 1203 | . 1204 | 1205 | 1206 | Open Scope type_scope. 1207 | 1208 | Definition a_result := (list (list a_prop * a_single_result) * N). 1209 | (* the second element is the length of the list *) 1210 | 1211 | Fixpoint for_all_pairs {A : Type} (lst : list A) (rel : A -> A -> bool) := 1212 | match lst with 1213 | | nil => true 1214 | | hd :: tl => 1215 | if (forallb (rel hd) tl) then 1216 | (for_all_pairs tl rel) 1217 | else false 1218 | end. 1219 | 1220 | Definition same_cond_same_val a_word_eq : (a_prop -> a_prop -> bool) := 1221 | fun a b => 1222 | match a, b with 1223 | | is_zero _, is_zero _ => true 1224 | | is_not_zero _, is_not_zero _ => true 1225 | | is_zero a, is_not_zero b => negb (a_word_eq a b) 1226 | | is_not_zero a, is_zero b => negb (a_word_eq a b) 1227 | end. 1228 | 1229 | Definition compat_conds a_word_eq (c : list a_prop * a_single_result) := 1230 | match c with 1231 | | (lst, _) => for_all_pairs lst (same_cond_same_val a_word_eq) 1232 | end. 1233 | 1234 | Definition cond_incompat a_word_eq a b:= 1235 | negb (same_cond_same_val a_word_eq a b). 1236 | 1237 | Close Scope type_scope. 1238 | 1239 | 1240 | 1241 | Open Scope N_scope. 1242 | 1243 | Fixpoint len {A} (lst : list A) := 1244 | match lst with 1245 | | nil => 0 1246 | | hd :: tl => 1247 | 1 + (len tl) 1248 | end. 1249 | 1250 | Definition a_result_from_list lst : a_result := 1251 | (lst, len lst). 1252 | 1253 | Definition a_operation_sem (instr : Lang.instr) (op : a_operation) (pre: a_state) : a_result := 1254 | match pre.(a_prg_sfx) with 1255 | | nil => ((nil, end_of_program pre) :: nil, 0) 1256 | | _ :: tl => 1257 | a_result_from_list ( 1258 | map 1259 | (fun cond_opt => 1260 | match cond_opt with 1261 | | (cond, None) => (cond, failure pre) 1262 | | (cond, Some (s,m)) => 1263 | if (Nat.ltb 1024 (length s))%nat then 1264 | (cond, failure pre) 1265 | else 1266 | (cond, 1267 | continue {| a_stc := s ; 1268 | a_mem := m ; 1269 | a_str := pre.(a_str) ; 1270 | a_log := pre.(a_log) ; 1271 | a_program := pre.(a_program); 1272 | a_prg_sfx := tl; 1273 | a_program_code := pre.(a_program_code); 1274 | last_instruction := instr 1275 | |}) 1276 | end) 1277 | (op pre.(a_stc) pre.(a_mem))) 1278 | end. 1279 | 1280 | Fixpoint take_n {A} (n : nat) (lst : list A) : option (list A * list A) := 1281 | match n, lst with 1282 | | O, _ => Some (nil, lst) 1283 | | S n', hd :: tl => 1284 | match take_n n' tl with 1285 | | Some (heads, tails) => Some (hd :: heads, tails) 1286 | | None => None 1287 | end 1288 | | S n', nil => None 1289 | end. 1290 | 1291 | Definition a_log_n (n : nat) (instr : Lang.instr) (pre : a_state) : a_result := 1292 | match pre.(a_prg_sfx) with 1293 | | nil => ((nil, failure pre) :: nil, 1) 1294 | | _ :: prg_tl => 1295 | match pre.(a_stc) with 1296 | | start :: size :: tl => 1297 | match take_n n tl with 1298 | | None => ((nil, failure pre) :: nil, 1) 1299 | | Some (heads, tails) => 1300 | ((nil, 1301 | continue {| a_stc := tails; 1302 | a_mem := pre.(a_mem); 1303 | a_str := pre.(a_str); 1304 | a_log := 1305 | {| 1306 | a_log_address := Aaddress; 1307 | a_log_topics := heads; 1308 | a_log_data := Atake' start size pre.(a_mem) 1309 | |} :: pre.(a_log); (* XXX: log is cons'ed, not appended at the end!!! *) 1310 | a_program := pre.(a_program); 1311 | a_program_code := pre.(a_program_code); 1312 | a_prg_sfx := prg_tl; 1313 | last_instruction := instr 1314 | |}) :: nil, 1) 1315 | end 1316 | | _ => ((nil, failure pre) :: nil, 1) 1317 | end 1318 | end. 1319 | 1320 | Definition a_noop (instr : Lang.instr) (pre : a_state) : a_result := 1321 | match pre.(a_prg_sfx) with 1322 | | nil => ((nil, end_of_program pre) :: nil, 1) 1323 | | _ :: tl => 1324 | ((nil, 1325 | continue {| a_stc := pre.(a_stc); 1326 | a_mem := pre.(a_mem); 1327 | a_str := pre.(a_str); 1328 | a_log := pre.(a_log); 1329 | a_program := pre.(a_program); 1330 | a_program_code := pre.(a_program_code); 1331 | a_prg_sfx := tl; 1332 | last_instruction := instr 1333 | |}) :: nil, 1) 1334 | end. 1335 | 1336 | Definition a_reader (f : a_state -> a_word) (instr : Lang.instr) (pre : a_state) : a_result := 1337 | match pre.(a_prg_sfx) with 1338 | | nil => ((nil, end_of_program pre) :: nil, 1) 1339 | | _ :: tl => 1340 | ((nil, continue {| a_stc := f pre :: pre.(a_stc) ; 1341 | a_mem := pre.(a_mem) ; 1342 | a_str := pre.(a_str) ; 1343 | a_log := pre.(a_log) ; 1344 | a_program := pre.(a_program); 1345 | a_program_code := pre.(a_program_code); 1346 | a_prg_sfx := tl; 1347 | last_instruction := instr 1348 | |}) :: nil, 1) 1349 | end. 1350 | 1351 | Import Lang. 1352 | 1353 | Definition comp {A B C} (g : B -> C) (f : A -> B) := fun x => (g (f x)). 1354 | 1355 | Close Scope string_scope. 1356 | 1357 | Definition simple_result' x := a_result_from_list (simple_result x). 1358 | 1359 | Definition check_jump_dst lst prestate c := 1360 | match lst with 1361 | | JUMPDEST :: _ => c 1362 | | _ => failure 1363 | (update_last_instruction prestate JUMP) 1364 | end. 1365 | 1366 | Definition a_instr_sem (i : instr) : a_state -> a_result := 1367 | let a_operation_sem' := a_operation_sem i in 1368 | match i with 1369 | | STOP => (fun pre => ((nil, stopped pre) :: nil, 1)) 1370 | | ADD => a_operation_sem ADD a_add_op 1371 | | MUL => a_operation_sem MUL a_mul_op 1372 | | SUB => a_operation_sem SUB a_sub_op 1373 | | DIV => a_operation_sem DIV a_div_op 1374 | | SDIV => a_operation_sem SDIV a_sdiv_op 1375 | | MOD => a_operation_sem MOD a_mod_op 1376 | | SMOD => a_operation_sem SMOD a_smod_op 1377 | | ADDMOD => a_operation_sem ADDMOD a_addmod_op 1378 | | MULMOD => a_operation_sem MULMOD a_mulmod_op 1379 | | SIGNEXTEND => a_operation_sem SIGNEXTEND a_signextend_op 1380 | | EXP => a_operation_sem EXP a_exp_op 1381 | | GT => a_operation_sem GT a_gt_op 1382 | | LT => a_operation_sem LT a_lt_op 1383 | | SLT => a_operation_sem SLT a_slt_op 1384 | | SGT => a_operation_sem SGT a_sgt_op 1385 | | EQ => a_operation_sem EQ a_eq_op 1386 | | AND => a_operation_sem' a_and_op 1387 | | OR => a_operation_sem' a_or_op 1388 | | XOR => a_operation_sem' a_xor_op 1389 | | NOT => a_operation_sem' a_not_op 1390 | | BYTE => a_operation_sem' a_byte_op 1391 | | ISZERO => a_operation_sem ISZERO a_iszero 1392 | | GAS => a_reader (fun _ => Aunknown "remaining_gas") GAS 1393 | | CALLER => a_reader (fun _ => Acaller) CALLER 1394 | | CALLVALUE => a_reader (fun _ => Avalue) CALLVALUE 1395 | | CALLDATALOAD => a_operation_sem' a_calldataload 1396 | | CALLDATASIZE => a_operation_sem' a_calldatasize 1397 | | CALLDATACOPY => a_operation_sem' a_calldatacopy 1398 | | BALANCE => a_operation_sem' a_balance 1399 | | ADDRESS => a_operation_sem' a_address 1400 | | TIMESTAMP => a_reader (fun _ => Atime) TIMESTAMP 1401 | | POP => a_operation_sem' a_pop 1402 | | MLOAD => a_operation_sem' a_mload 1403 | | MSTORE => a_operation_sem' a_mstore 1404 | | MSTORE8 => a_operation_sem' a_mstore8 1405 | | SLOAD => (fun pre => a_operation_sem' (a_sload pre.(a_str)) pre) 1406 | | SSTORE => (fun pre => 1407 | simple_result' 1408 | match pre.(a_stc) with 1409 | | nil => failure pre 1410 | | _ :: nil => failure pre 1411 | | addr :: val :: stl => 1412 | match pre.(a_prg_sfx) with 1413 | | nil => failure pre 1414 | | _ :: cont => 1415 | continue {| 1416 | a_stc := stl; 1417 | a_mem := pre.(a_mem); 1418 | a_str := Aput_storage addr val pre.(a_str); 1419 | a_log := pre.(a_log); 1420 | a_program := pre.(a_program); 1421 | a_program_code := pre.(a_program_code); 1422 | a_prg_sfx := cont; 1423 | last_instruction := SSTORE 1424 | |} 1425 | end 1426 | end) 1427 | | JUMP => (fun pre => 1428 | simple_result' 1429 | match pre.(a_stc) with 1430 | | nil => failure pre 1431 | | Aimm_nat jmp :: tl => 1432 | (* if NPeano.leb 1433 | (List.length pre.(a_prg_sfx)) 1434 | (List.length (drop_bytes pre.(a_program) (literal_to_nat jmp))) 1435 | then 1436 | back_jmp pre 1437 | else *) 1438 | let sfx := drop_bytes pre.(a_program) (N.to_nat jmp) in 1439 | check_jump_dst sfx pre 1440 | (continue {| 1441 | a_stc := tl; 1442 | a_mem := pre.(a_mem); 1443 | a_str := pre.(a_str); 1444 | a_log := pre.(a_log); 1445 | a_program := pre.(a_program); 1446 | a_program_code := pre.(a_program_code); 1447 | a_prg_sfx := sfx; 1448 | last_instruction := JUMP 1449 | |}) 1450 | | _ => not_implemented i pre 1451 | end 1452 | ) 1453 | | JUMPI => (fun pre => 1454 | match pre.(a_stc) with 1455 | | nil => simple_result' (failure pre) 1456 | | hd::nil => simple_result' (failure pre) 1457 | | Aimm_nat dst :: cond :: tl_stc => 1458 | a_result_from_list 1459 | ((is_zero cond :: nil, 1460 | match pre.(a_prg_sfx) with 1461 | | nil => failure pre 1462 | | _ :: tl => 1463 | continue {| 1464 | a_stc := tl_stc; 1465 | a_mem := pre.(a_mem); 1466 | a_str := pre.(a_str); 1467 | a_log := pre.(a_log); 1468 | a_program := pre.(a_program); 1469 | a_program_code := pre.(a_program_code); 1470 | a_prg_sfx := tl; 1471 | last_instruction := JUMPI 1472 | |} 1473 | end) 1474 | :: 1475 | (is_not_zero cond :: nil, 1476 | (* if NPeano.leb 1477 | (List.length pre.(a_prg_sfx)) 1478 | (List.length (drop_bytes pre.(a_program) (literal_to_nat dst))) 1479 | then 1480 | back_jmp pre 1481 | else *) 1482 | let sfx := drop_bytes pre.(a_program) (N.to_nat dst) in 1483 | check_jump_dst sfx pre 1484 | (continue {| 1485 | a_stc := tl_stc; 1486 | a_mem := pre.(a_mem); 1487 | a_str := pre.(a_str); 1488 | a_log := pre.(a_log); 1489 | a_program := pre.(a_program); 1490 | a_program_code := pre.(a_program_code); 1491 | a_prg_sfx := sfx; 1492 | last_instruction := JUMPI 1493 | |})) 1494 | :: nil) 1495 | | _ => simple_result' (not_implemented i pre) 1496 | end) 1497 | | JUMPDEST => 1498 | (fun pre => match pre.(a_prg_sfx) with 1499 | | nil => simple_result' (failure pre) 1500 | | _ :: tl => 1501 | simple_result' ( 1502 | continue {| 1503 | a_stc := pre.(a_stc); 1504 | a_mem := pre.(a_mem); 1505 | a_str := pre.(a_str); 1506 | a_log := pre.(a_log); 1507 | a_program := pre.(a_program); 1508 | a_program_code := pre.(a_program_code); 1509 | a_prg_sfx := tl; 1510 | last_instruction := JUMPDEST 1511 | |} ) 1512 | end) 1513 | | PUSH_N str => a_operation_sem' (a_push_x (Aimm str)) 1514 | | DUP1 => a_operation_sem' a_dup1 1515 | | DUP2 => a_operation_sem' a_dup2 1516 | | DUP3 => a_operation_sem' a_dup3 1517 | | DUP4 => a_operation_sem' a_dup4 1518 | | DUP5 => a_operation_sem' (a_dup_n 5) 1519 | | DUP6 => a_operation_sem' (a_dup_n 6) 1520 | | DUP7 => a_operation_sem' (a_dup_n 7) 1521 | | DUP8 => a_operation_sem' (a_dup_n 8) 1522 | | DUP9 => a_operation_sem' (a_dup_n 9) 1523 | | DUP10 => a_operation_sem' (a_dup_n 10) 1524 | | DUP11 => a_operation_sem' (a_dup_n 11) 1525 | | DUP12 => a_operation_sem' (a_dup_n 12) 1526 | | DUP13 => a_operation_sem' (a_dup_n 13) 1527 | | DUP14 => a_operation_sem' (a_dup_n 14) 1528 | | DUP15 => a_operation_sem' (a_dup_n 15) 1529 | | DUP16 => a_operation_sem' (a_dup_n 16) 1530 | | SWAP1 => a_operation_sem' a_swap1 1531 | | SWAP2 => a_operation_sem' a_swap2 1532 | | SWAP3 => a_operation_sem' a_swap3 1533 | | SWAP4 => a_operation_sem' a_swap4 1534 | | SWAP5 => a_operation_sem' a_swap5 1535 | | SWAP6 => a_operation_sem' a_swap6 1536 | | SWAP7 => a_operation_sem' a_swap7 1537 | | SWAP8 => a_operation_sem' a_swap8 1538 | | SWAP9 => a_operation_sem' a_swap9 1539 | | SWAP10 => a_operation_sem' a_swap10 1540 | | SWAP11 => a_operation_sem' a_swap11 1541 | | SWAP12 => a_operation_sem' a_swap12 1542 | | SWAP13 => a_operation_sem' a_swap13 1543 | | SWAP14 => a_operation_sem' a_swap14 1544 | | SWAP15 => a_operation_sem' a_swap15 1545 | | SWAP16 => a_operation_sem' a_swap16 1546 | | LOG0 => a_log_n 0 LOG0 1547 | | LOG1 => a_log_n 1 LOG1 1548 | | LOG2 => a_log_n 2 LOG2 1549 | | LOG3 => a_log_n 3 LOG3 1550 | | LOG4 => a_log_n 4 LOG4 1551 | | CALL => 1552 | (fun pre => 1553 | simple_result' 1554 | match pre.(a_stc) with 1555 | | e0 :: e1 :: e2 :: e3 :: e4 :: e5 :: e6 :: rest => 1556 | calling {| a_call_gaslimit := e0 1557 | ; a_caller := Aaddress 1558 | ; a_call_code := e1 1559 | ; a_call_recipient := e1 1560 | ; a_call_value := e2 1561 | ; a_call_data_begin := e3 1562 | ; a_call_data_size := e4 1563 | ; a_call_output_dst := e5 1564 | ; a_call_output_max := e6 1565 | ; a_call_pre := pre (* TODO: maybe remove the seven stack elements already *) 1566 | |} 1567 | | _ => failure pre 1568 | end) 1569 | | CREATE => 1570 | (fun pre => 1571 | simple_result' 1572 | match pre.(a_stc) with 1573 | | value :: mem_start :: mem_size :: rest => 1574 | creating {| 1575 | a_create_value := value 1576 | ; a_create_mem_start := mem_start 1577 | ; a_create_mem_size := mem_size 1578 | |} 1579 | | _ => failure pre 1580 | end 1581 | ) 1582 | | DELEGATECALL => 1583 | (fun pre => 1584 | simple_result' 1585 | match pre.(a_stc) with 1586 | | e0 :: e1 :: e3 :: e4 :: e5 :: e6 :: rest => 1587 | (* TODO: the yellow paper says DELEGATECALL takes 6 arguments instead of 7! *) 1588 | calling {| 1589 | a_call_gaslimit := e0 1590 | ; a_call_code := e1 1591 | ; a_caller := Acaller 1592 | ; a_call_recipient := Aaddress 1593 | ; a_call_value := Avalue 1594 | ; a_call_data_begin := e3 1595 | ; a_call_data_size := e4 1596 | ; a_call_output_dst := e5 1597 | ; a_call_output_max := e6 1598 | ; a_call_pre := pre (* TODO: maybe remove the seven stack elements already *) 1599 | |} 1600 | | _ => failure pre 1601 | end) 1602 | | CALLCODE => 1603 | (fun pre => 1604 | simple_result' 1605 | match pre.(a_stc) with 1606 | | e0 :: e1 :: e2 :: e3 :: e4 :: e5 :: e6 :: rest => 1607 | calling {| a_call_gaslimit := e0 1608 | ; a_caller := Aaddress 1609 | ; a_call_code := e1 1610 | ; a_call_recipient := Aaddress 1611 | ; a_call_value := e2 1612 | ; a_call_data_begin := e3 1613 | ; a_call_data_size := e4 1614 | ; a_call_output_dst := e5 1615 | ; a_call_output_max := e6 1616 | ; a_call_pre := pre (* TODO: maybe remove the seven stack elements already *) 1617 | |} 1618 | | _ => failure pre 1619 | end) 1620 | | RETURN => 1621 | (fun pre => 1622 | simple_result' 1623 | match pre.(a_stc) with 1624 | | start :: size :: rest => 1625 | returned (Atake' start size pre.(a_mem)) pre 1626 | | _ => 1627 | failure pre 1628 | end) 1629 | | SUICIDE => (fun pre => 1630 | simple_result' 1631 | match pre.(a_stc) with 1632 | | nil => failure pre 1633 | | hd :: _ => suicide hd 1634 | end 1635 | ) 1636 | | CODECOPY => a_operation_sem' a_codecopy 1637 | | SHA3 => a_operation_sem' a_sha3 1638 | | ORIGIN => a_reader (fun _ => Aorigin) ORIGIN 1639 | | CODESIZE => a_reader (fun state => Aimm_nat (program_bytes state.(a_program))) CODESIZE 1640 | | GASPRICE => a_reader (fun _ => Agas_price) GASPRICE 1641 | | NUMBER => a_reader (fun _ => Ablock_number) NUMBER 1642 | | COINBASE => a_reader (fun _ => Acoinbase) COINBASE 1643 | | BLOCKHASH => a_reader (fun _ => Ablockhash) BLOCKHASH 1644 | | DIFFICULTY => a_reader (fun _ => Adifficulty) DIFFICULTY 1645 | | GASLIMIT => a_reader (fun _ => Agaslimit) GASLIMIT 1646 | | MSIZE => a_operation_sem' a_msize 1647 | | PC => a_reader (fun state => 1648 | Aimm_nat 1649 | ( program_bytes state.(a_program) 1650 | - program_bytes state.(a_prg_sfx)) 1651 | ) PC 1652 | | EXTCODESIZE => a_operation_sem' a_extcodesize 1653 | | EXTCODECOPY => 1654 | (fun pre => 1655 | simple_result' 1656 | match pre.(a_stc) with 1657 | | addr :: memory_start :: code_start :: len :: rest => 1658 | extcode_copying 1659 | {| 1660 | a_extcode_copy_addr := addr ; 1661 | a_extcode_copy_memory_start := memory_start ; 1662 | a_extcode_copy_code_start := code_start ; 1663 | a_extcode_copy_len := len |} 1664 | | _ => failure pre 1665 | end 1666 | ) 1667 | | UNKNOWN _ => comp simple_result' (not_implemented i) 1668 | end. 1669 | 1670 | Fixpoint optmap {A B : Type} (f : A -> option B) lst := 1671 | match lst with 1672 | | nil => nil 1673 | | hd :: tl => 1674 | match f hd with 1675 | | None => optmap f tl 1676 | | Some hh => hh :: optmap f tl 1677 | end 1678 | end. 1679 | 1680 | Definition conflict a_word_eq (conds0 conds1 : list a_prop) : bool := 1681 | if forallb (fun orig => 1682 | forallb (fun new => 1683 | (same_cond_same_val a_word_eq orig new) 1684 | ) conds0 1685 | ) conds1 then 1686 | false else true. 1687 | 1688 | Definition satisfiable (a_word_eq : a_word -> a_word -> bool) (cond : a_prop) : bool := 1689 | match cond with 1690 | | is_zero (Aimm_nat x) => Neqb x 0 1691 | | is_not_zero (Aimm_nat x) => negb (Neqb x 0) 1692 | | _ => true 1693 | end. 1694 | 1695 | Definition unsatisfiable a_word_eq conds : bool := 1696 | if forallb (fun c => satisfiable a_word_eq c) conds 1697 | then false else true. 1698 | 1699 | Definition append_cond (a_word_eq : a_word -> a_word -> bool) (cond : list a_prop) (r : a_result) : a_result := 1700 | match r with (lst, len) => 1701 | let left := (optmap (fun sr => 1702 | match sr with 1703 | | (c', x) => 1704 | (* if forallb (fun orig => 1705 | forallb (fun new => 1706 | negb (a_word_eq orig new) 1707 | ) cond 1708 | ) c' then *) 1709 | Some (cond ++ c', x) 1710 | (* else 1711 | None *) 1712 | end) lst) in 1713 | (left, len) 1714 | end. 1715 | 1716 | Fixpoint flat_map' {A B : Type} (number_checker : N -> N) 1717 | (f : A -> prod (list B) N) (a_lst : list A) : prod (list B) N := 1718 | match a_lst with 1719 | | (nil) => (nil, 0) 1720 | | (a :: tl_a) => 1721 | match flat_map' number_checker f tl_a with 1722 | | (tl_b, tl_num) => 1723 | match f a with 1724 | (hd_bs, hd_num) => 1725 | (app hd_bs tl_b, number_checker (hd_num + tl_num)) 1726 | end 1727 | end 1728 | end. 1729 | 1730 | Fixpoint a_exec conds number_checker a_word_eq (n : nat) (st : a_single_result) : a_result := 1731 | match st with 1732 | | continue pre => 1733 | match n, pre.(a_prg_sfx) with 1734 | | O, _ => ((nil, continue pre) :: nil, 1) 1735 | | S n', hd::_ => 1736 | flat_map' number_checker 1737 | (fun s_result => 1738 | match s_result with 1739 | | (cond, x) => 1740 | if unsatisfiable a_word_eq cond then (nil, 0) else 1741 | if conflict a_word_eq cond conds then (nil, 0) else 1742 | append_cond a_word_eq cond (a_exec (cond ++ conds) number_checker a_word_eq n' x) 1743 | end) 1744 | (fst (a_instr_sem hd pre)) 1745 | | S n', nil => simple_result' (end_of_program pre) 1746 | end 1747 | | _ => simple_result' st 1748 | end 1749 | . 1750 | 1751 | Definition a_ex (r : decode_result) (code : string) initial_storage : a_single_result := 1752 | match r with 1753 | | decode_success prog => 1754 | continue {| 1755 | a_stc := nil; 1756 | a_mem := Aempty; 1757 | a_str := initial_storage; 1758 | a_log := nil; 1759 | a_program := prog; 1760 | a_program_code := match code with 1761 | | String "0" (String "x" y) => y 1762 | | _ => code 1763 | end ; 1764 | a_prg_sfx := prog; 1765 | last_instruction := JUMPDEST 1766 | |} 1767 | | decode_failure reason => decode_fail reason 1768 | end. 1769 | 1770 | Definition a_run a_word_eq number_checker n code initial_storage := 1771 | (a_exec nil number_checker a_word_eq n (a_ex (decode code) code initial_storage)). 1772 | 1773 | End AbstractEVM. 1774 | -------------------------------------------------------------------------------- /extract.v: -------------------------------------------------------------------------------- 1 | Require Import ExtrOcamlBasic. 2 | Require Import ExtrOcamlString. 3 | Require Import ExtrOcamlNatInt. 4 | Require Import ExtrOcamlZBigInt. 5 | 6 | Require Import evm. 7 | 8 | 9 | Extract Inductive unit => "unit" [ "()" ]. 10 | (* Extract Inductive bool => "bool" [ "true" "false" ].*) 11 | Extract Inductive list => "list" [ "[]" "(::)" ]. 12 | Extract Inductive prod => "(*)" [ "(,)" ]. 13 | 14 | Recursive Extraction Library evm. 15 | -------------------------------------------------------------------------------- /main.ml: -------------------------------------------------------------------------------- 1 | open Getopt 2 | open Lwt 3 | open Cohttp 4 | open Cohttp_lwt_unix 5 | 6 | open Evm;; 7 | 8 | Lwt_log.default := 9 | Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stderr () 10 | ;; 11 | 12 | let rec hex_of_big_int_ (n : Big_int.big_int) = 13 | let le = Big_int.le_big_int in 14 | let bofi = Big_int.big_int_of_int in 15 | if le n (bofi 9) then Big_int.string_of_big_int n 16 | else if le n (bofi 15) then 17 | (match Big_int.int_of_big_int n with 18 | | 10 -> "a" 19 | | 11 -> "b" 20 | | 12 -> "c" 21 | | 13 -> "d" 22 | | 14 -> "e" 23 | | 15 -> "f" 24 | | _ -> failwith "hex_of_big_int_ broken" 25 | ) 26 | else 27 | let (q, r) = Big_int.quomod_big_int n (bofi 16) in 28 | (hex_of_big_int_ q) ^ (hex_of_big_int_ r) 29 | ;; 30 | 31 | let hex_of_big_int n = "0x"^(hex_of_big_int_ n);; 32 | 33 | open AbstractEVM;; 34 | 35 | exception TooManyCases;; 36 | 37 | let number_checker (n : Big_int.big_int) = 38 | if Big_int.le_big_int (Big_int.big_int_of_int 30000) n then raise TooManyCases; 39 | n;; 40 | 41 | let rec len lst = 42 | match lst with 43 | | [] -> 0 44 | | _ :: tl -> 1 + (len tl);; 45 | 46 | let parens str = "("^str^")";; 47 | 48 | let binary f op v0 v1 = 49 | parens (f v0^op^f v1);; 50 | 51 | let rec simplify_val v = 52 | (match v with 53 | | Aadd (x,y) -> Aadd (simplify_val x, simplify_val y) 54 | | Asub (x,y) -> Asub (simplify_val x, simplify_val y) 55 | | Aget32 (addr, mem) -> 56 | (match (simplify_val addr, simplify_mem_focus addr mem) with 57 | | (a, m) -> Aget32 (a, m)) 58 | | _ -> v) 59 | and simplify_mem_focus addr (m : a_memory) = m 60 | and simplify_mem m = 61 | match m with 62 | | Atake (st, size, orig) -> 63 | Atake ((simplify_val st), (simplify_val size), (simplify_mem orig)) 64 | | Aput32 (addr, v, orig) -> 65 | Aput32 ((simplify_val addr), (simplify_val v), (simplify_mem orig)) 66 | | _ -> m;; 67 | 68 | 69 | let rec a_val_to_str v = 70 | let bin = binary a_val_to_str in 71 | match v with 72 | | Abyte (idx, w) -> (a_val_to_str w)^"["^(a_val_to_str idx)^"]" 73 | | Acaller -> "(address of caller)" 74 | | Atime -> "(timestamp)" 75 | | Agas_price -> "(gasprice)" 76 | | Ablock_number -> "(block number)" 77 | | Ablockhash -> "(blockhash)" 78 | | Adifficulty -> "(difficulty)" 79 | | Agaslimit -> "(gaslimit)" 80 | | Acoinbase -> "(coinbase)" 81 | | Aorigin -> "(address of original external account)" 82 | | Adatasize -> "(size of input)" 83 | | Avalue -> "(value of this call)" 84 | | Aaddress -> "(address of this contract)" 85 | | Abalance addr -> "(balance of "^a_val_to_str addr^")" 86 | | Aunknown explanation -> "(unknown ("^BatString.implode explanation^"))" 87 | | Ais_zero v' -> "(is_zero "^a_val_to_str v'^")" 88 | | Azero -> "0" 89 | | Aextcodesize a -> "(code size of address "^a_val_to_str a^")" 90 | | Asub (v0, v1) -> bin " - " v0 v1 91 | | Aadd (v0, v1) -> bin " + " v0 v1 92 | | Aand (v0, v1) -> bin " and " v0 v1 93 | | Aor (v0, v1) -> bin " or " v0 v1 94 | | Axor (v0, v1) -> bin " xor " v0 v1 95 | | Aexp (v0, v1) -> bin " ** " v0 v1 96 | | Adiv (v0, v1) -> bin " / " v0 v1 97 | | Amod (v0, v1) -> bin " mod " v0 v1 98 | | Asmod (v0, v1) -> bin " smod " v0 v1 99 | | Asdiv (v0, v1) -> bin " sdiv " v0 v1 100 | | Amul (v0, v1) -> bin " * " v0 v1 101 | | Agt (v0, v1) -> bin " > " v0 v1 102 | | Anot v -> "(not "^(a_val_to_str v)^")" 103 | | Alt (v0, v1) -> bin " < " v0 v1 104 | | Aslt (v0, v1) -> bin " slt " v0 v1 105 | | Aeq (v0, v1) -> bin " == " v0 v1 106 | | Asignextend (v0, v1) -> "(signextend "^(a_val_to_str v1)^" from "^(a_val_to_str v0)^"bytes)" 107 | | Aget32 (addr, mem) -> "(get32 "^(a_val_to_str addr)^" "^(a_memory_to_str mem false)^")" 108 | | Aget_storage (addr, str) -> "(get_storage "^(a_val_to_str addr)^" "^(a_storage_to_str str false)^")" 109 | | Asha3 mem -> "(sha3 "^(a_memory_to_str mem false)^")" 110 | | Aimm_nat imm -> Printf.sprintf "(%s)" (hex_of_big_int imm) 111 | and a_memory_to_str m block = 112 | (if block then 113 | "
" 114 | else 115 | "" 116 | )^ 117 | begin match m with 118 | | Aempty -> "(empty)" 119 | | Aput32 (addr,v,orig) -> 120 | Printf.sprintf "(mem_write32 addr: %s val: %s in %s)" (a_val_to_str addr) (a_val_to_str v) (a_memory_to_str orig block) 121 | | Aput1 (addr,v,orig) -> 122 | Printf.sprintf "(mem_write_byte addr: %s val: (%s mod 256) in %s)" (a_val_to_str addr) (a_val_to_str v) (a_memory_to_str orig block) 123 | | Amemwrite (start_addr, len, source, mem) -> 124 | Printf.sprintf "%s; copy from %s [0, %s) at offset %s" (a_memory_to_str mem block) (a_memory_to_str source false) (a_val_to_str len) (a_val_to_str start_addr) 125 | | Adata -> "(input data)" 126 | | Adrop (num, orig) -> Printf.sprintf "(drop first %s bytes from %s)" 127 | (a_val_to_str num) (a_memory_to_str orig block) 128 | | Atake (start, size, orig) -> Printf.sprintf "(take %s bytes at %s from %s)" 129 | (a_val_to_str size) (a_val_to_str start) (a_memory_to_str orig block) 130 | | Amem_imm _ -> "a_mem_to_str imm not implemented" 131 | | Acodecopy (memstart, codestart, size, orig) -> 132 | Printf.sprintf "(codecopy mem: %s, code: %s, size: %s, on %s)" 133 | (a_val_to_str memstart) 134 | (a_val_to_str codestart) 135 | (a_val_to_str size) 136 | (a_memory_to_str orig block) 137 | | Aconcat (w0, w1) -> 138 | Printf.sprintf "(concat %s %s)" (a_val_to_str w0) (a_val_to_str w1) 139 | end^(if block then "
" else "") 140 | and a_storage_to_str m block = 141 | (if block then 142 | "
" 143 | else 144 | "" 145 | )^ 146 | begin match m with 147 | | Ainitial_storage -> "(initial storage)" 148 | | Aput_storage (addr,v,orig) -> 149 | Printf.sprintf "(storage_write at: %s, val: %s %s)" (a_val_to_str addr) (a_val_to_str v) (a_storage_to_str orig block) 150 | end^(if block then "
" else "") 151 | ;; 152 | 153 | open Lang;; 154 | 155 | let istr_to_str istr = 156 | match istr with 157 | | STOP -> "STOP" 158 | | ADD -> "ADD" 159 | | MUL -> "MUL" 160 | | SUB -> "SUB" 161 | | DIV -> "DIV" 162 | | SDIV -> "SDIV" 163 | | MOD -> "MOD" 164 | | SMOD -> "SMOD" 165 | | ADDMOD -> "ADDMOD" 166 | | MULMOD -> "MULMOD" 167 | | SIGNEXTEND -> "SIGNEXTEND" 168 | | EXP -> "EXP" 169 | | GT -> "GT" 170 | | SGT -> "SGT" 171 | | EQ -> "EQ" 172 | | LT -> "LT" 173 | | SLT -> "SLT" 174 | | AND -> "AND" 175 | | OR -> "OR" 176 | | XOR -> "XOR" 177 | | NOT -> "NOT" 178 | | BYTE -> "BYTE" 179 | | ISZERO -> "ISZERO" 180 | | SHA3 -> "SHA3" 181 | | ADDRESS -> "ADDRESS" 182 | | BALANCE -> "BALANCE" 183 | | ORIGIN -> "ORIGIN" 184 | | CALLER -> "CALLER" 185 | | CALLVALUE -> "CALLVALUE" 186 | | CALLDATALOAD -> "CALLDATALOAD" 187 | | CALLDATASIZE -> "CALLDATASIZE" 188 | | CALLDATACOPY -> "CALLDATACOPY" 189 | | CODESIZE -> "CODESIZE" 190 | | CODECOPY -> "CODECOPY" 191 | | GASPRICE -> "GASPRICE" 192 | | EXTCODESIZE -> "EXTCODESIZE" 193 | | EXTCODECOPY -> "EXTCODECOPY" 194 | | BLOCKHASH -> "BLOCKHASH" 195 | | COINBASE -> "COINBASE" 196 | | TIMESTAMP -> "TIMESTAMP" 197 | | NUMBER -> "NUMBER" 198 | | DIFFICULTY -> "DIFFICULTY" 199 | | GASLIMIT -> "GASLIMIT" 200 | | POP -> "POP" 201 | | MLOAD -> "MLOAD" 202 | | MSTORE -> "MSTORE" 203 | | MSTORE8 -> "MSTORE8" 204 | | SLOAD -> "SLOAD" 205 | | SSTORE -> "SSTORE" 206 | | JUMP -> "JUMP" 207 | | JUMPI -> "JUMPI" 208 | | PC -> "PC" 209 | | MSIZE -> "MSIZE" 210 | | GAS -> "GAS" 211 | | JUMPDEST -> "JUMPDEST" 212 | | PUSH_N data -> "PUSH_N"^(BatString.implode data) 213 | | DUP1 -> "DUP1" 214 | | DUP2 -> "DUP2" 215 | | DUP3 -> "DUP3" 216 | | DUP4 -> "DUP4" 217 | | DUP5 -> "DUP5" 218 | | DUP6 -> "DUP6" 219 | | DUP7 -> "DUP7" 220 | | DUP8 -> "DUP8" 221 | | DUP9 -> "DUP9" 222 | | DUP10 -> "DUP10" 223 | | DUP11 -> "DUP11" 224 | | DUP12 -> "DUP12" 225 | | DUP13 -> "DUP13" 226 | | DUP14 -> "DUP14" 227 | | DUP15 -> "DUP15" 228 | | DUP16 -> "DUP16" 229 | | SWAP1 -> "SWAP1" 230 | | SWAP2 -> "SWAP2" 231 | | SWAP3 -> "SWAP3" 232 | | SWAP4 -> "SWAP4" 233 | | SWAP5 -> "SWAP5" 234 | | SWAP6 -> "SWAP6" 235 | | SWAP7 -> "SWAP7" 236 | | SWAP8 -> "SWAP8" 237 | | SWAP9 -> "SWAP9" 238 | | SWAP10 -> "SWAP10" 239 | | SWAP11 -> "SWAP11" 240 | | SWAP12 -> "SWAP12" 241 | | SWAP13 -> "SWAP13" 242 | | SWAP14 -> "SWAP14" 243 | | SWAP15 -> "SWAP15" 244 | | SWAP16 -> "SWAP16" 245 | | LOG0 -> "LOG0" 246 | | LOG1 -> "LOG1" 247 | | LOG2 -> "LOG2" 248 | | LOG3 -> "LOG3" 249 | | LOG4 -> "LOG4" 250 | | CREATE -> "CREATE" 251 | | CALL -> "CALL" 252 | | DELEGATECALL -> "DELEGATECALL" 253 | | CALLCODE -> "CALLCODE" 254 | | RETURN -> "RETURN" 255 | | SUICIDE -> "SUICIDE" 256 | | UNKNOWN str -> "UNKNOWN "^(BatString.implode str);; 257 | 258 | let cond_to_str cond = 259 | begin 260 | match cond with 261 | | Coq_is_zero v 262 | | Coq_is_not_zero v -> 263 | a_val_to_str v 264 | end^ 265 | begin 266 | match cond with 267 | | Coq_is_zero _ -> " is zero." 268 | | Coq_is_not_zero _ -> " is not zero." 269 | end;; 270 | 271 | let rec simplify_cond c = 272 | match c with 273 | | Coq_is_zero (Ais_zero v) -> 274 | simplify_cond (Coq_is_not_zero v) 275 | | Coq_is_not_zero (Ais_zero v) -> 276 | simplify_cond (Coq_is_zero v) 277 | | _ -> c;; 278 | 279 | let show_condition cond : string = 280 | Printf.sprintf "
  • %s
    • \n" (cond_to_str (simplify_cond cond));; 281 | 282 | let stack_to_str stc = 283 | "["^ 284 | (StringLabels.concat ", " (CoqList.map a_val_to_str stc)) 285 | ^"]"^(Printf.sprintf "(size %d)" (len stc)) 286 | 287 | let state_to_str s = 288 | Printf.sprintf 289 | ("{
    last instruction: %s
    stack: %s
    memory: %s
    storage: %s
    log: XXX
    remaining_program: XXX
    }") 290 | (istr_to_str s.last_instruction) 291 | (stack_to_str s.a_stc) 292 | (a_memory_to_str s.a_mem true) 293 | (a_storage_to_str s.a_str true) 294 | ;; 295 | 296 | let print_call c = 297 | Printf.sprintf "code at address: %s
    " (a_val_to_str c.a_call_code)^ 298 | Printf.sprintf "recipient address: %s
    " (a_val_to_str c.a_call_recipient)^ 299 | Printf.sprintf "value: %s
    " (a_val_to_str c.a_call_value)^ 300 | Printf.sprintf "caller: %s
    " (a_val_to_str c.a_caller) 301 | ;; 302 | 303 | let print_create c = 304 | Printf.sprintf "with value: %s
    " (a_val_to_str c.a_create_value)^ 305 | Printf.sprintf "with code from memory idx %s and size %s
    " 306 | (a_val_to_str c.a_create_mem_start) 307 | (a_val_to_str c.a_create_mem_size) 308 | ;; 309 | 310 | let print_extcode_copy e = 311 | Printf.sprintf "with addr: %s
    " (a_val_to_str e.a_extcode_copy_addr)^ 312 | Printf.sprintf "with memory start: %s
    " (a_val_to_str e.a_extcode_copy_memory_start)^ 313 | Printf.sprintf "with code start: %s
    " (a_val_to_str e.a_extcode_copy_code_start)^ 314 | Printf.sprintf "with length: %s
    " (a_val_to_str e.a_extcode_copy_len) 315 | ;; 316 | 317 | let show_single_result r = 318 | match r with 319 | | Coq_continue s -> Printf.sprintf "still running with state %s." (state_to_str s) 320 | | Coq_suicide addr -> Printf.sprintf "suicides with inheritance to %s." (a_val_to_str addr) 321 | | Coq_returned (output, state) -> Printf.sprintf "returns with output %s and state %s." (a_memory_to_str (simplify_mem output) true) (state_to_str state) 322 | | Coq_stopped s -> Printf.sprintf "stops with state %s." (state_to_str s) 323 | | Coq_calling c -> (Printf.sprintf "calls something:
    ")^ 324 | (print_call c)^ 325 | Printf.sprintf "
    It's unknown what happens during/after the call." 326 | | Coq_creating c -> (Printf.sprintf "tries to create something:
    ")^ 327 | (print_create c)^ 328 | Printf.sprintf "
    It's unknown what happens during/after the create." 329 | | Coq_extcode_copying e -> 330 | (Printf.sprintf "tries to copy code of an account:
    ")^ 331 | (print_extcode_copy e)^ 332 | Printf.sprintf "
    It's unknown what happens during/after the code copying." 333 | | Coq_end_of_program s -> Printf.sprintf "reaches the end of the program with state %s." (state_to_str s) 334 | | Coq_failure s -> Printf.sprintf "causes runtime error with state %s." (state_to_str s) 335 | | Coq_not_implemented (istr, st) -> Printf.sprintf "hits an unimplemented instruction %s in this analyzer." (istr_to_str istr) 336 | | Coq_decode_fail str -> Printf.sprintf "causing parsing failure in this analyzer: %s." (BatString.implode str) 337 | | Coq_back_jmp s -> Printf.sprintf "causes a backward jump (and so the automatic analysis gives up). The final state is %s." (state_to_str s) 338 | ;; 339 | 340 | let show_result num ((conds : a_prop list), r) = 341 | (Printf.sprintf "

    Behavior %d

    " num)^ 342 | (Printf.sprintf "

    under conditions:

    ")^ 343 | (Printf.sprintf "
      \n")^ 344 | (if conds = [] then "
    1. unconditionally!
      2. " else 345 | BatString.join "\n" (List.map show_condition conds))^ 346 | (Printf.sprintf "
    \n")^ 347 | (show_single_result r) 348 | ;; 349 | 350 | let port = ref 8000 351 | 352 | let specs = [ 353 | ('p', "port", None, Some (fun str -> port := int_of_string str)) 354 | ] 355 | 356 | let filter_hex = 357 | BatString.filter 358 | (fun c -> 359 | match c with 360 | | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' | 'a' | 'b'| 'c' | 'd' |'e' |'f' | 'x' -> true 361 | | _ -> false) 362 | 363 | (* returns true when two abstract values are known to be equal *) 364 | let rec aval_eq a b = 365 | (match a, b with 366 | | Acaller, Acaller -> true 367 | | Atime, Atime -> true 368 | | Adatasize, Adatasize -> true 369 | | Avalue, Avalue -> true 370 | | Aaddress, Aaddress -> true 371 | | Abalance v, Abalance w -> aval_eq v w 372 | | Adifficulty, Adifficulty -> true 373 | | Agaslimit, Agaslimit -> true 374 | | Ablockhash, Ablockhash -> true 375 | | Ablock_number, Ablock_number -> true 376 | | Aimm_nat abig, Aimm_nat bbig -> Big_int.eq_big_int abig bbig 377 | | Aunknown _, _ -> false 378 | | _, Aunknown _ -> false 379 | | Ais_zero av, Ais_zero bv -> aval_eq av bv 380 | | Azero, Azero -> true 381 | | Asub (a0, a1), Asub (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 382 | | Aadd (a0, a1), Aadd (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 383 | | Aand (a0, a1), Aand (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 384 | | Aor (a0, a1), Aor (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 385 | | Axor (a0, a1), Axor (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 386 | | Aexp (a0, a1), Aexp (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 387 | | Adiv (a0, a1), Adiv (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 388 | | Asdiv (a0, a1), Asdiv (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 389 | | Amod (a0, a1), Amod (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 390 | | Asmod (a0, a1), Asmod (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 391 | | Amul (a0, a1), Amul (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 392 | | Agt (a0, a1), Agt (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 393 | | Aextcodesize a, Aextcodesize b -> aval_eq a b 394 | | Asignextend (a0, a1), Asignextend (b0, b1) -> 395 | aval_eq a0 b0 && aval_eq a1 b1 396 | | Anot a_, Anot b_ -> aval_eq a_ b_ 397 | | Asha3 am, Asha3 bm -> false 398 | | Alt (a0, a1), Alt (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 399 | | Aslt (a0, a1), Aslt (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 400 | | Abyte (a0, a1), Abyte (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 401 | | Aeq (a0, a1), Aeq (b0, b1) -> aval_eq a0 b0 && aval_eq a1 b1 402 | | Aget32 (ai, am), Aget32 (bi, bm) -> aval_eq ai bi && am_eq am bm 403 | | (Aget_storage (ai, a_s), Aget_storage (bi, b_s)) -> 404 | aval_eq ai bi && ast_eq a_s b_s 405 | | _, _ -> false) 406 | and ast_eq a b = 407 | match a, b with 408 | | Ainitial_storage, Ainitial_storage -> true 409 | | _, _ -> false 410 | and am_eq a b = 411 | match a, b with 412 | | Adata, Adata -> true 413 | | _, _ -> false 414 | 415 | let rec parse_storage_inner (strs : string list) (current : Evm.AbstractEVM.a_storage) : Evm.AbstractEVM.a_storage = 416 | match strs with 417 | | [] -> current 418 | | [a] -> 419 | Printf.eprintf "single %s\n%!" a; 420 | failwith "odd number of strings" 421 | | k :: v :: rest -> 422 | Printf.eprintf "pair %s %s\n%!" k v; 423 | let k = Big_int.big_int_of_string k in 424 | let v = Big_int.big_int_of_string v in 425 | parse_storage_inner rest Evm.AbstractEVM.(Aput_storage (Aimm_nat k, Aimm_nat v, current)) 426 | 427 | let parse_storage (input : string) : Evm.AbstractEVM.a_storage = 428 | parse_storage_inner (Str.split (Str.regexp "[ \t\n\012\r]+") input) Evm.AbstractEVM.Ainitial_storage 429 | ;; 430 | 431 | 432 | let generate_link code steps storage_str = 433 | Printf.sprintf "./?nsteps=%s&contract=%s&storage=%s" (string_of_int steps) code (Netencoding.Url.encode storage_str) 434 | 435 | let body_creator uri meth headers = 436 | (fun body -> 437 | ((Printf.sprintf " 438 | 439 | Dr. Y's Ethereum Contract Analyzer 440 | 444 | 445 | 446 |

    Dr. Y's Ethereum Contract Analyzer

    447 |
    448 | Maximal number of steps to analyze: 449 |
    450 | Contract:
    451 |
    452 |
    453 | Storage (optional):
    454 |
    455 |
    " 456 | (match Uri.get_query_param uri "nsteps" with 457 | | None -> "400" 458 | | Some str -> string_of_int (int_of_string str) 459 | ) 460 | (match Uri.get_query_param uri "contract" with 461 | | None -> "0x3660008037602060003660003473273930d21e01ee25e4c219b63259d214872220a261235a5a03f21560015760206000f3" 462 | | Some str -> 463 | let filtered = filter_hex str in 464 | filtered 465 | ) 466 | (match Uri.get_query_param uri "storage" with 467 | | None -> "" 468 | | Some str -> str) 469 | ) 470 | ^ 471 | (match Uri.get_query_param uri "contract", Uri.get_query_param uri "nsteps" with 472 | | None, _ -> "" 473 | | _, None -> "" 474 | | Some code, Some steps -> 475 | try 476 | let filtered = filter_hex code in 477 | let steps = (if filtered = "0x0x0x" then 400 else int_of_string steps) in 478 | let steps = if steps < 0 then 0 else steps in 479 | let code_coq : char list = BatString.explode filtered in 480 | let storage_str : string = 481 | (match Uri.get_query_param uri "storage" with 482 | | None -> "" 483 | | Some str -> str) in 484 | let storage_coq : Evm.AbstractEVM.a_storage = parse_storage storage_str in 485 | let (result, result_len) = 486 | a_run aval_eq number_checker steps code_coq storage_coq 487 | in 488 | (Printf.sprintf 489 | "

    Code

    490 | 
    %s
    491 |

    Behaviors

    492 |

    %d behaviors cover the possibilities (assuming enough gas).

    493 |

    back fwd

    494 | " 495 | (filter_hex code) 496 | (Big_int.int_of_big_int result_len) 497 | (generate_link filtered (steps - 1) storage_str) 498 | (generate_link filtered (steps + 1) storage_str) 499 | )^ 500 | (BatString.concat "\n" (List.mapi show_result result)) 501 | with TooManyCases -> 502 | Printf.sprintf "

    Results

    Too many behaviors found. Maybe there is a loop.

    " 503 | | e -> 504 | Printf.printf "an exception %s %s \n%!" (Printexc.to_string e) (Printexc.get_backtrace ()); 505 | raise e 506 | ) 507 | ^ 508 | (" 509 |
    510 |

    TODO

    511 |
      512 |
    • Consider the stack depsth limitation.
      • 513 |
    • Consider uint256 overflow/underflow (currently the concrete values are taken as natural numbers).
      • 514 |
    • Test the symbolic execution against other implementations.
      • 515 |
    • Translate the Yellow Paper faithfully to a theorem prover and then prove that the symbolic execution matches the Yellow Paper.
      • 516 |
    517 |
    518 |
    519 | Yoichi Hirai 520 |
    Contact: i@yoichihirai.com
    521 |
    GitHub: view source and file issues
    522 | 523 | ") 524 | )) 525 | 526 | let callback _conn req body = 527 | let uri = req |> Request.uri in 528 | let meth = req |> Request.meth |> Code.string_of_method in 529 | let headers = req |> Request.headers |> Header.to_string in 530 | body |> Cohttp_lwt_body.to_string >|= 531 | body_creator uri meth headers 532 | >>= (fun body -> Server.respond_string ~status:`OK ~body ()) 533 | >>= (fun k -> 534 | Lwt_log.notice_f "%f %s %s %s" (Unix.time ()) (uri |> Uri.to_string) meth headers >>= 535 | (fun _ -> return k) 536 | ) 537 | 538 | let () = 539 | Printexc.record_backtrace true; 540 | Getopt.parse_cmdline specs print_endline; 541 | let server = 542 | Server.create ~mode:(`TCP (`Port !port)) (Server.make ~callback ()) in 543 | let () = Printf.printf "Starting a web server at port %d\n%!" !port in 544 | ignore (Lwt_main.run server) 545 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Dr. Y's Ethereum Contract Analyzer 2 | 3 | [Online version](http://dry.yoichihirai.com/) 4 | 5 | ## How to use 6 | 7 | * Install OCaml (4.02.3 works) and [opam](https://opam.ocaml.org/) 8 | * `opam install lwt cohttp coq getopt batteries ocamlnet` 9 | * `make` 10 | * `./main.native -p 9999` 11 | * access [localhost:9999](http://localhost:9999) 12 | * paste some EVM bytecode (beginning from 0x) in the text box 13 | * hit "Analyze" button 14 | * the analyzer tells what the bytecode does, to some point 15 | 16 | ## LICENSE 17 | 18 | * `big.ml` comes from the Coq development team under LGPL version 2.1 19 | * The other files are currently distributed with LGPL version 2.1. 20 | 21 | --------------------------------------------------------------------------------