[
  {
    "path": ".gitignore",
    "content": "*~\n*.native\n_build\nsetup.data\nsetup.log\n.DS_Store\n.merlin\n.bsb.lock\nnpm-debug.log\n/lib/bs/\n/lib/js/\n/node_modules/\nsrc/parse/lexer.ml\nsrc/parse/parser.ml\n\n"
  },
  {
    "path": ".gitmodules",
    "content": "[submodule \"bamboo-tests\"]\n\tpath = bamboo-tests\n\turl = https://github.com/pirapira/bamboo-tests.git\n"
  },
  {
    "path": ".travis.yml",
    "content": "notifications:\n  webhooks:\n    urls:\n      - https://webhooks.gitter.im/e/4f71b9fa80e108068016\n    on_success: change  # options: [always|never|change] default: always\n    on_failure: always  # options: [always|never|change] default: always\n    on_start: never     # options: [always|never|change] default: always\ndist: trusty\ncache:\n  directories:\n  - $HOME/.ccache\n  - $HOME/build/pirapira/cpp-ethereum\n  - $HOME/build/pirapira/cmake\nenv:\n  global:\n  - CASHER_TIME_OUT=1200\nsudo: required\nbefore_install:\n- BAMBOO=`pwd`\n- sudo apt-get -qq update\n- sudo apt-get install aspcud ccache jq\n# - git clone https://github.com/polyml/polyml.git\n# - cd polyml\n# - git checkout v5.6\n# - ./configure\n# - make\n# - make compiler\n# - sudo make install\n# - cd -\n# - sudo updatedb\n# - locate libpolymain.a\n- wget https://raw.github.com/ocaml/opam/master/shell/opam_installer.sh -O - | sudo sh -s /usr/local/bin\n- export OPAMJOBS=2\n- opam init -y --comp=4.02.3+buckle-master\n- opam switch 4.02.3+buckle-master\n- eval `opam config env`\n- opam update\n- opam upgrade -y\n# It's important to install batteries first, so the proper version of rpc can be installed afterwards\n- git clone https://github.com/bsansouci/batteries-included\n- cd ./batteries-included && opam pin add -y batteries . && cd ..\n- opam install -y ocamlfind menhir rope zarith ppx_deriving rpc=1.9.52 cryptokit hex\n- cd ../..\n- if [ ! -d cpp-ethereum/.git ]; then rm -rf cpp-ethereum; git clone https://github.com/pirapira/cpp-ethereum --recursive; fi\n- sudo apt install -y build-essential libgmp-dev libleveldb-dev libmicrohttpd-dev g++-4.8 gcc-4.8\n- sudo apt purge -y cmake\n- mkdir -p cmake\n- cd cmake\n- if [ ! -f cmake-3.8.2-Linux-x86_64.tar.gz ]; then wget https://cmake.org/files/v3.8/cmake-3.8.2-Linux-x86_64.tar.gz && tar xf cmake-3.8.2-Linux-x86_64.tar.gz; fi\n- PATH=`pwd`/cmake-3.8.2-Linux-x86_64/bin:$PATH\n- cd -\n- cmake --version\n- cd cpp-ethereum\n- git fetch\n- git checkout origin/test-raw-sign\n- git show | head -n 3\n- git submodule update --recursive\n- mkdir -p build\n- cd build\n- CC=gcc-4.8 CXX=g++-4.8 cmake ..\n- CC=gcc-4.8 CXX=g++-4.8 make -j3 eth\n- sudo make install\n- cd $BAMBOO\n- sudo apt install texlive-latex-base texlive-science texlive-math-extra\ninstall:\n- npm install\n- cd bamboo-tests\n- npm install\n- cd -\nscript:\n- make doc/spec.pdf\n- make\n- ln -s ./bamboo.native lib/bs/native/bamboo\n- PATH=`pwd`/lib/bs/native:$PATH\n- cd bamboo-tests\n- npm test\n- cd -\n- make test\n- which eth\n- eth --version\n- mkdir -p /tmp/test\n- eth --test -d /tmp/test &> eth.log &\n- PID=$!\n- sleep 4\n- endtoend.native\n- kill $PID\n- cat eth.log\n- opam pin add bamboo . -y\n- opam remove bamboo\n- opam install bamboo -y\n"
  },
  {
    "path": "LICENSE",
    "content": "                                 Apache License\n                           Version 2.0, January 2004\n                        http://www.apache.org/licenses/\n\n   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION\n\n   1. Definitions.\n\n      \"License\" shall mean the terms and conditions for use, reproduction,\n      and distribution as defined by Sections 1 through 9 of this document.\n\n      \"Licensor\" shall mean the copyright owner or entity authorized by\n      the copyright owner that is granting the License.\n\n      \"Legal Entity\" shall mean the union of the acting entity and all\n      other entities that control, are controlled by, or are under common\n      control with that entity. For the purposes of this definition,\n      \"control\" means (i) the power, direct or indirect, to cause the\n      direction or management of such entity, whether by contract or\n      otherwise, or (ii) ownership of fifty percent (50%) or more of the\n      outstanding shares, or (iii) beneficial ownership of such entity.\n\n      \"You\" (or \"Your\") shall mean an individual or Legal Entity\n      exercising permissions granted by this License.\n\n      \"Source\" form shall mean the preferred form for making modifications,\n      including but not limited to software source code, documentation\n      source, and configuration files.\n\n      \"Object\" form shall mean any form resulting from mechanical\n      transformation or translation of a Source form, including but\n      not limited to compiled object code, generated documentation,\n      and conversions to other media types.\n\n      \"Work\" shall mean the work of authorship, whether in Source or\n      Object form, made available under the License, as indicated by a\n      copyright notice that is included in or attached to the work\n      (an example is provided in the Appendix below).\n\n      \"Derivative Works\" shall mean any work, whether in Source or Object\n      form, that is based on (or derived from) the Work and for which the\n      editorial revisions, annotations, elaborations, or other modifications\n      represent, as a whole, an original work of authorship. For the purposes\n      of this License, Derivative Works shall not include works that remain\n      separable from, or merely link (or bind by name) to the interfaces of,\n      the Work and Derivative Works thereof.\n\n      \"Contribution\" shall mean any work of authorship, including\n      the original version of the Work and any modifications or additions\n      to that Work or Derivative Works thereof, that is intentionally\n      submitted to Licensor for inclusion in the Work by the copyright owner\n      or by an individual or Legal Entity authorized to submit on behalf of\n      the copyright owner. For the purposes of this definition, \"submitted\"\n      means any form of electronic, verbal, or written communication sent\n      to the Licensor or its representatives, including but not limited to\n      communication on electronic mailing lists, source code control systems,\n      and issue tracking systems that are managed by, or on behalf of, the\n      Licensor for the purpose of discussing and improving the Work, but\n      excluding communication that is conspicuously marked or otherwise\n      designated in writing by the copyright owner as \"Not a Contribution.\"\n\n      \"Contributor\" shall mean Licensor and any individual or Legal Entity\n      on behalf of whom a Contribution has been received by Licensor and\n      subsequently incorporated within the Work.\n\n   2. Grant of Copyright License. Subject to the terms and conditions of\n      this License, each Contributor hereby grants to You a perpetual,\n      worldwide, non-exclusive, no-charge, royalty-free, irrevocable\n      copyright license to reproduce, prepare Derivative Works of,\n      publicly display, publicly perform, sublicense, and distribute the\n      Work and such Derivative Works in Source or Object form.\n\n   3. Grant of Patent License. Subject to the terms and conditions of\n      this License, each Contributor hereby grants to You a perpetual,\n      worldwide, non-exclusive, no-charge, royalty-free, irrevocable\n      (except as stated in this section) patent license to make, have made,\n      use, offer to sell, sell, import, and otherwise transfer the Work,\n      where such license applies only to those patent claims licensable\n      by such Contributor that are necessarily infringed by their\n      Contribution(s) alone or by combination of their Contribution(s)\n      with the Work to which such Contribution(s) was submitted. If You\n      institute patent litigation against any entity (including a\n      cross-claim or counterclaim in a lawsuit) alleging that the Work\n      or a Contribution incorporated within the Work constitutes direct\n      or contributory patent infringement, then any patent licenses\n      granted to You under this License for that Work shall terminate\n      as of the date such litigation is filed.\n\n   4. Redistribution. You may reproduce and distribute copies of the\n      Work or Derivative Works thereof in any medium, with or without\n      modifications, and in Source or Object form, provided that You\n      meet the following conditions:\n\n      (a) You must give any other recipients of the Work or\n          Derivative Works a copy of this License; and\n\n      (b) You must cause any modified files to carry prominent notices\n          stating that You changed the files; and\n\n      (c) You must retain, in the Source form of any Derivative Works\n          that You distribute, all copyright, patent, trademark, and\n          attribution notices from the Source form of the Work,\n          excluding those notices that do not pertain to any part of\n          the Derivative Works; and\n\n      (d) If the Work includes a \"NOTICE\" text file as part of its\n          distribution, then any Derivative Works that You distribute must\n          include a readable copy of the attribution notices contained\n          within such NOTICE file, excluding those notices that do not\n          pertain to any part of the Derivative Works, in at least one\n          of the following places: within a NOTICE text file distributed\n          as part of the Derivative Works; within the Source form or\n          documentation, if provided along with the Derivative Works; or,\n          within a display generated by the Derivative Works, if and\n          wherever such third-party notices normally appear. The contents\n          of the NOTICE file are for informational purposes only and\n          do not modify the License. You may add Your own attribution\n          notices within Derivative Works that You distribute, alongside\n          or as an addendum to the NOTICE text from the Work, provided\n          that such additional attribution notices cannot be construed\n          as modifying the License.\n\n      You may add Your own copyright statement to Your modifications and\n      may provide additional or different license terms and conditions\n      for use, reproduction, or distribution of Your modifications, or\n      for any such Derivative Works as a whole, provided Your use,\n      reproduction, and distribution of the Work otherwise complies with\n      the conditions stated in this License.\n\n   5. Submission of Contributions. Unless You explicitly state otherwise,\n      any Contribution intentionally submitted for inclusion in the Work\n      by You to the Licensor shall be under the terms and conditions of\n      this License, without any additional terms or conditions.\n      Notwithstanding the above, nothing herein shall supersede or modify\n      the terms of any separate license agreement you may have executed\n      with Licensor regarding such Contributions.\n\n   6. Trademarks. This License does not grant permission to use the trade\n      names, trademarks, service marks, or product names of the Licensor,\n      except as required for reasonable and customary use in describing the\n      origin of the Work and reproducing the content of the NOTICE file.\n\n   7. Disclaimer of Warranty. Unless required by applicable law or\n      agreed to in writing, Licensor provides the Work (and each\n      Contributor provides its Contributions) on an \"AS IS\" BASIS,\n      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or\n      implied, including, without limitation, any warranties or conditions\n      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A\n      PARTICULAR PURPOSE. You are solely responsible for determining the\n      appropriateness of using or redistributing the Work and assume any\n      risks associated with Your exercise of permissions under this License.\n\n   8. Limitation of Liability. In no event and under no legal theory,\n      whether in tort (including negligence), contract, or otherwise,\n      unless required by applicable law (such as deliberate and grossly\n      negligent acts) or agreed to in writing, shall any Contributor be\n      liable to You for damages, including any direct, indirect, special,\n      incidental, or consequential damages of any character arising as a\n      result of this License or out of the use or inability to use the\n      Work (including but not limited to damages for loss of goodwill,\n      work stoppage, computer failure or malfunction, or any and all\n      other commercial damages or losses), even if such Contributor\n      has been advised of the possibility of such damages.\n\n   9. Accepting Warranty or Additional Liability. While redistributing\n      the Work or Derivative Works thereof, You may choose to offer,\n      and charge a fee for, acceptance of support, warranty, indemnity,\n      or other liability obligations and/or rights consistent with this\n      License. However, in accepting such obligations, You may act only\n      on Your own behalf and on Your sole responsibility, not on behalf\n      of any other Contributor, and only if You agree to indemnify,\n      defend, and hold each Contributor harmless for any liability\n      incurred by, or claims asserted against, such Contributor by reason\n      of your accepting any such warranty or additional liability.\n\n   END OF TERMS AND CONDITIONS\n\n   APPENDIX: How to apply the Apache License to your work.\n\n      To apply the Apache License to your work, attach the following\n      boilerplate notice, with the fields enclosed by brackets \"{}\"\n      replaced with your own identifying information. (Don't include\n      the brackets!)  The text should be enclosed in the appropriate\n      comment syntax for the file format. We also recommend that a\n      file or class name and description of purpose be included on the\n      same \"printed page\" as the copyright notice for easier\n      identification within third-party archives.\n\n   Copyright 2016 Yoichi Hirai\n\n   Licensed under the Apache License, Version 2.0 (the \"License\");\n   you may not use this file except in compliance with the License.\n   You may obtain a copy of the License at\n\n       http://www.apache.org/licenses/LICENSE-2.0\n\n   Unless required by applicable law or agreed to in writing, software\n   distributed under the License is distributed on an \"AS IS\" BASIS,\n   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.\n   See the License for the specific language governing permissions and\n   limitations under the License.\n"
  },
  {
    "path": "Makefile",
    "content": ".PHONY: test bamboo clean dep\n\nbamboo:\n\tnpm run build\n\ndep:\n\tnpm install\n\topam switch 4.02.3+buckle-master\n\teval `opam config env`\n\t# It's important to install batteries first, so the proper version of rpc can be installed afterwards\n\tgit clone https://github.com/bsansouci/batteries-included ./node_modules/batteries-included\n\tcd ./node_modules/batteries-included && opam pin add -y batteries . && cd ../..\n\topam install -y ocamlfind menhir rope zarith ppx_deriving rpc=1.9.52 cryptokit hex\n\ndoc/spec.pdf: doc/spec.tex\n\t(cd doc; pdflatex -halt-on-error spec.tex; pdflatex -halt-on-error spec.tex)\n\ntest:\n\t(cd src; sh ./run_tests.sh)\n\nclean:\n\tnpm run clean\n"
  },
  {
    "path": "README.md",
    "content": "# Bamboo: a language for morphing smart contracts\n\nCornell Blockchain says they can now maintain the Bamboo compiler. https://github.com/CornellBlockchain/bamboo\n\n<hr>\n\n[![Join the chat at https://gitter.im/bbo-dev/Lobby](https://badges.gitter.im/bbo-dev/Lobby.svg)](https://gitter.im/bbo-dev/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)\n\n[![Build Status](https://travis-ci.org/pirapira/bamboo.svg?branch=master)](https://travis-ci.org/pirapira/bamboo)\n\nBamboo is a programming language for Ethereum contracts.\nBamboo makes state transition explicit and avoids reentrance problems by default.\nSee [manifest](doc/manifest.md) for the motivation, or [tutorial](doc/tutorial.md) if you want to deploy something first, or [semantics](doc/semantics.md) if you need something resembling a definition.\n\n## Example Bamboo Code\n\n* [A payment channel](./src/parse/examples/00h_payment_channel.bbo)\n* [An ERC20 contract](./src/parse/examples/01b_erc20better.bbo)\n* [A vault](https://medium.com/@pirapira/implementing-a-vault-in-bamboo-9c08241b6755)\n\n## Compiler\n\nThe Bamboo compiler sometimes produces bytecode, which needs to be tested.\n\nAs preparation,\n* install [opam](http://opam.ocaml.org/doc/Install.html) with OCaml 4.04.1\n* `opam install bamboo`\nshould install `bamboo`.\n\nWhen you check out this repository,\n```\nbamboo < src/parse/examples/006auction_first_case.bbo\n```\nproduces a bytecode. Do not trust the output as the compiler still contains bugs probably.\n\n```\nbamboo --abi < src/parse/examples/006auction_first_case.bbo\n```\nprints ABI.\n```\n[{\"type\": \"constructor\", \"inputs\":[{\"name\": \"_beneficiary\", \"type\": \"address\"},{\"name\": \"_bidding_time\", \"type\": \"uint256\"},{\"name\": \"_highest_bid\", \"type\": \"uint256\"}], \"name\": \"auction\", \"outputs\":[], \"payable\": true},{\"type\":\"fallback\",\"inputs\": [],\"outputs\": [],\"payable\": true}]\n```\n\n## Developing Bamboo\n\nTo try Bamboo in your local environment, run `make dep` from the project folder. That should install all dependencies.\nOnce the installation process is done, run `eval $(opam config env)` and then you can build all targets using `make`, and run the tests with `make test`.\n\nWhen you modify the OCaml source of Bamboo, you can try your version by\n```\n$ make\n$ ./lib/bs/native/bamboo.native < src/parse/examples/006auction_first_case.bbo\n```\n\n**Embark**\n\nAn [Embark plugin for Bamboo](https://github.com/embark-framework/embark-bamboo) is available. To use it, first install [Embark](https://embark.status.im/docs/) and add then add the plugin to your DApp.\n\n```Javascript\nnpm install -g embark\nembark new AppName\ncd AppName\nnpm install embark-bamboo --save\n```\n\nthen add embark-bamboo to the plugins section in ```embark.json```:\n\n```Json\n  \"plugins\": {\n    \"embark-bamboo\": {}\n  }\n```\n\nAfterwards Embark will recognize .bbo files and compile them with Bamboo.\n\n## How to Contribute\n\n* notice problems and point them out. [create issues](https://github.com/pirapira/bamboo/issues/new).\n* test the bytecode like [this](doc/tutorial.md), but using other examples.  You might find bugs in the compiler.\n* write new Bamboo code and test the compiler.\n* join the [Gitter channel](https://gitter.im/bbo-dev/Lobby).\n* spread a rumor to your friends who are into programming languages.\n\n## Related Work\n\n### Linden Scripting Language\n\n[Linden Scripting Language](http://wiki.secondlife.com/wiki/Getting_started_with_LSL#Introducing_States_and_Events) has similar organization of code according to `state`s.\n\n### Obsidian\n\n[Obsidian](https://ieeexplore.ieee.org/document/7965268/) is another programming language that models smart contracts as state machines.  Obsidian even tracks states of the contracts statically.\n"
  },
  {
    "path": "ReleaseNotes.txt",
    "content": "Version 0.0.03 (2018-05-04)\n\n* fixes incorrect characters in the ABI https://github.com/pirapira/bamboo/issues/279\n* integration tests with Ganache-cli https://github.com/pirapira/bamboo/pull/263\n* bamboo.js using BuckleScript https://github.com/pirapira/bamboo/pull/260\n\nVersion 0.0.02 (2017-10-13)\n\n* decimal literals #208 by @aupiff\n* detecting racing side-effects #186\n* banning the keyword uint in favor of uint256\n* More elegant parser using Menhir libraries\n"
  },
  {
    "path": "__tests__/compare-js-native.js",
    "content": "// A small script to test if both versions (JS and native) output the same\n// string given the same programs as input\n// To run: `node compare-js-native.js`\n\nconst fs = require('fs');\nconst path = require('path');\nconst execSync = require('child_process').execSync;\nconst examplesFolder = '../src/parse/examples';\n\nfs.readdir(examplesFolder, (err, files) => {\n  files.forEach(file => {\n    console.log(`Comparing native vs js output for file: ${file}...`);\n    const filePath = path.join(examplesFolder, file);\n    const jsOutput = execSync(`node ../lib/js/src/exec-js/bambooJs.js < ${filePath}`).toString();\n    const nativeOutput = execSync(`../bamboo.native < ${filePath}`).toString();\n    const equal = jsOutput === nativeOutput;\n    console.log(`Result: ${equal ? 'ok' : 'DIFF'}\\n`);\n  });\n})"
  },
  {
    "path": "_oasis",
    "content": "OASISFormat: 0.4\nName:        bamboo\nVersion:     0.0.03\nSynopsis:    A compiler targeting Ethereum Virtual Machine\nAuthors:     Yoichi Hirai <i@yoichihirai.com>\nLicense:     Apache-2.0\nPlugins:     META (0.4)\nHomepage:    https://github.com/pirapira/bamboo\nDescription: Bamboo compiles a simple language to Ethereum Virtual Machine. The language is designed to keep programmers away from common mistakes. It features: state transition as recursion with potentially changing arguments, mandatory reentrance continuation when calling out, no loops, no assignments except to mappings and partial compliance with common Ethereum ABI.\nSourceRepository opam-pin\n  Type: Git\n  Location: https://github.com/pirapira/bamboo.git\n  Branch: master\nExecutable bamboo\n  Path:       src/exec\n  Install: true\n  BuildTools: ocamlbuild\n  MainIs:     bamboo.ml\n  CompiledObject: best\n  BuildDepends: parse, codegen\nLibrary ast\n  Path:       src/ast\n  Install:    false\n  BuildTools: ocamlbuild\n  Modules:    Contract, Syntax, TypeEnv, Type, PseudoImm, Evm, Location, Ethereum\n  BuildDepends: basics, cryptokit (>= 1.12), hex\nLibrary basics\n  Path:       src/basics\n  Install:    false\n  BuildTools: ocamlbuild\n  Modules:    Assoc, Hexa, Label, Misc, Storage\n  BuildDepends: cross-platform\nLibrary cross-platform\n  Path:       src/cross-platform-for-ocamlbuild\n  Install:    false\n  BuildTools: ocamlbuild\n  Modules:    WrapBn, WrapCryptokit, WrapList, WrapString, WrapOption\n  BuildDepends: batteries,rope,cryptokit (>= 1.12),hex\nLibrary codegen\n  Path:       src/codegen\n  Install:    false\n  BuildTools: ocamlbuild\n  Modules:    CodegenEnv, Codegen, EntrypointDatabase,\n    LayoutInfo, LocationEnv, Parse\n  BuildDepends: basics, ast, parse\nLibrary parse\n  Path:       src/parse\n  Install:    false\n  BuildTools: ocamlbuild\n  Modules:    Lexer\n  BuildDepends: ast, menhirLib\n"
  },
  {
    "path": "_tags",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: c348eeadfb15aa1af2d805f976b82290)\n# Ignore VCS directories, you can use the same kind of rule outside\n# OASIS_START/STOP if you want to exclude directories that contains\n# useless stuff for the build process\ntrue: annot, bin_annot\n<**/.svn>: -traverse\n<**/.svn>: not_hygienic\n\".bzr\": -traverse\n\".bzr\": not_hygienic\n\".hg\": -traverse\n\".hg\": not_hygienic\n\".git\": -traverse\n\".git\": not_hygienic\n\"_darcs\": -traverse\n\"_darcs\": not_hygienic\n# Library cross-platform\n\"src/cross-platform-for-ocamlbuild/cross-platform.cmxs\": use_cross-platform\n<src/cross-platform-for-ocamlbuild/*.ml{,i,y}>: pkg_batteries\n<src/cross-platform-for-ocamlbuild/*.ml{,i,y}>: pkg_cryptokit\n<src/cross-platform-for-ocamlbuild/*.ml{,i,y}>: pkg_hex\n<src/cross-platform-for-ocamlbuild/*.ml{,i,y}>: pkg_rope\n# Library basics\n\"src/basics/basics.cmxs\": use_basics\n<src/basics/*.ml{,i,y}>: pkg_batteries\n<src/basics/*.ml{,i,y}>: pkg_cryptokit\n<src/basics/*.ml{,i,y}>: pkg_hex\n<src/basics/*.ml{,i,y}>: pkg_rope\n<src/basics/*.ml{,i,y}>: use_cross-platform\n# Library ast\n\"src/ast/ast.cmxs\": use_ast\n<src/ast/*.ml{,i,y}>: pkg_batteries\n<src/ast/*.ml{,i,y}>: pkg_cryptokit\n<src/ast/*.ml{,i,y}>: pkg_hex\n<src/ast/*.ml{,i,y}>: pkg_rope\n<src/ast/*.ml{,i,y}>: use_basics\n<src/ast/*.ml{,i,y}>: use_cross-platform\n# Library parse\n\"src/parse/parse.cmxs\": use_parse\n<src/parse/*.ml{,i,y}>: pkg_batteries\n<src/parse/*.ml{,i,y}>: pkg_cryptokit\n<src/parse/*.ml{,i,y}>: pkg_hex\n<src/parse/*.ml{,i,y}>: pkg_menhirLib\n<src/parse/*.ml{,i,y}>: pkg_rope\n<src/parse/*.ml{,i,y}>: use_ast\n<src/parse/*.ml{,i,y}>: use_basics\n<src/parse/*.ml{,i,y}>: use_cross-platform\n# Library codegen\n\"src/codegen/codegen.cmxs\": use_codegen\n<src/codegen/*.ml{,i,y}>: pkg_batteries\n<src/codegen/*.ml{,i,y}>: pkg_cryptokit\n<src/codegen/*.ml{,i,y}>: pkg_hex\n<src/codegen/*.ml{,i,y}>: pkg_menhirLib\n<src/codegen/*.ml{,i,y}>: pkg_rope\n<src/codegen/*.ml{,i,y}>: use_ast\n<src/codegen/*.ml{,i,y}>: use_basics\n<src/codegen/*.ml{,i,y}>: use_cross-platform\n<src/codegen/*.ml{,i,y}>: use_parse\n# Executable bamboo\n<src/exec/bamboo.{native,byte}>: pkg_batteries\n<src/exec/bamboo.{native,byte}>: pkg_cryptokit\n<src/exec/bamboo.{native,byte}>: pkg_hex\n<src/exec/bamboo.{native,byte}>: pkg_menhirLib\n<src/exec/bamboo.{native,byte}>: pkg_rope\n<src/exec/bamboo.{native,byte}>: use_ast\n<src/exec/bamboo.{native,byte}>: use_basics\n<src/exec/bamboo.{native,byte}>: use_codegen\n<src/exec/bamboo.{native,byte}>: use_cross-platform\n<src/exec/bamboo.{native,byte}>: use_parse\n<src/exec/*.ml{,i,y}>: pkg_batteries\n<src/exec/*.ml{,i,y}>: pkg_cryptokit\n<src/exec/*.ml{,i,y}>: pkg_hex\n<src/exec/*.ml{,i,y}>: pkg_menhirLib\n<src/exec/*.ml{,i,y}>: pkg_rope\n<src/exec/*.ml{,i,y}>: use_ast\n<src/exec/*.ml{,i,y}>: use_basics\n<src/exec/*.ml{,i,y}>: use_codegen\n<src/exec/*.ml{,i,y}>: use_cross-platform\n<src/exec/*.ml{,i,y}>: use_parse\n# OASIS_STOP\ntrue: use_menhir\n<bamboo-tests>: -traverse\n<lib/bs>: -traverse\n<node_modules>: -traverse\n<batteries-included>: -traverse"
  },
  {
    "path": "bsconfig.json",
    "content": "{\n  \"name\": \"bamboo\",\n  \"version\": \"0.0.02\",\n  \"bsc-flags\": \"-w -27 -g\",\n  \"warnings\": {\n    \"number\": \"-40+6+7-26-27+32..39-28-44+45\",\n    \"error\": \"+8\"\n  },\n  \"bs-dependencies\": [\n    \"bs-bn.js\"\n  ],\n  \"ocamlfind-dependencies\": [\n    \"batteries\",\n    \"cryptokit\",\n    \"hex\",\n    \"ppx_deriving\",\n    \"ppx_deriving_rpc\",\n    \"rpclib.json\"\n  ],\n  \"generators\": [\n    {\n      \"name\": \"ocamllex\",\n      \"command\": \"ocamllex $in\"\n    },\n    {\n      \"name\": \"menhir\",\n      \"command\": \"menhir $in\"\n    }\n  ],\n  \"sources\": {\n    \"dir\": \"src\",\n    \"subdirs\": [\n      {\"dir\": \"ast\"},\n      {\"dir\": \"basics\"},\n      {\"dir\": \"codegen\"},\n      {\"dir\": \"cross-platform\"},\n      {\"backend\": \"native\", \"dir\": \"exec\"},\n      {\"backend\": \"js\", \"dir\": \"exec-js\"},\n      {\"dir\": \"lib\"},\n      {\"dir\": \"parse\",\n       \"generators\": [\n           {\n             \"name\": \"ocamllex\",\n             \"edge\": [\"lexer.ml\", \":\", \"lexer.mll\"]\n           },\n           {\n             \"name\": \"menhir\",\n             \"edge\": [\"parser.ml\", \"parser.mli\", \":\", \"parser.mly\"]\n           }\n           ]\n      }\n    ]\n  },\n  \"entries\": [\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Bamboo\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Codegen_test\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Codegen_test2\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Lib_test\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Hex_test\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Parser_test\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"Ast_test\"\n    },\n    {\n      \"backend\": \"native\",\n      \"main-module\": \"EndToEnd\"\n    },\n    {\n      \"backend\": \"js\",\n      \"main-module\": \"BambooJs\"\n    }\n  ],\n  \"refmt\": 3\n}\n"
  },
  {
    "path": "doc/manifest.md",
    "content": "# Bamboo Manifest\n\n## Problem\n\nSmart contracts should reduce surprises.\nThe code should reveal what can happen in which order, and the same\nordering must be enforced mechanically.  This is not done in the usual\nway of writing smart contracts where a smart contract is described as\nseveral interface functions.\n\nIn the following example, the names of functions suggest the timing of\nthe calls, but this ordering can only be enforced by careful timestamp\nchecking or global state tracking in the body of the functions.\n```\ncontract CrowdFund() {\n    case(void toBeCalledDuringFunding()) {\n        // ...\n    }\n\n    case(void toBeCalledAfterFailure()) {\n        // ...\n    }\n\n    case(void toBeCalledAfterSuccess()) {\n        // ...\n    }\n\n    case(void notSureWhatThisDoes()) {\n        // ...\n    }\n}\n```\nTo make my point clearer, I added the last function\n`notSureWhatThisDoes()`.  Whenever such a function exists the\ntemporal order is ambiguous. An interface function can be called\nat any moment by default.  A closer look is necessary for every\ninterface function before a reader or the machine can enumerate\nthe possible orderings of events.\n\n## Solution\n\nThe solution is polymorphic contracts.  According to the stages,\na contract changes its signature.\n\n```\ncontract Funding() {\n    case(bool toBeCalledDuringFunding()) {\n        // something something\n        return true then become Funding();\n    }\n    case(bool endFunding()) {\n        if (something)\n            return (true) then become FundingSuccess();\n        else\n            return (false) then become FundingFailure();\n    }\n}\n\ncontract FundingSuccess() {\n    case(void toBeCalledAfterSuccess()) {\n        // something\n    }\n}\n\ncontract FundingFailure() {\n    case(void toBeCalledAfterFailure()) {\n        // something\n    }\n}\n```\n\nAll of these contracts `Funding`, `FundingSuccess` and `FundingFailure` occupies the same address.  The initial contract `Funding` becomes `FundingSuccess` or `FundingFailure`.\n\nWhere has gone the `notSureWhatThisDoes()` function in the previous\nexample?  It's not there because, well, I am not sure where it goes.\nThe new style forces temporal organization of the code lines.\n\n### Syntax\n\nAfter some polishing I ended up to something like [this](../src/parse/examples/00d_auction.bbo).\nThere is some influence from Erlang.\n\n### Not to have\n\nThis language is designed to facilliate a particular style.\nSo the language will not support features like:\n* loop constructs (`for`, `while`, ...).  Due to the constant block gas limit, loops should be avoided and each iteration should be done in separate transactions.\n* assignments into storage variables, except array elements.  Instead of assigning a new value to a storage variable, the new value can be given as an argument in the continaution (e.g. `return () then auction(new_highest_bidder, ...)`\n"
  },
  {
    "path": "doc/semantics.md",
    "content": "# Bamboo Semantics Sketch\n\nThis document describes the semantics of the Bamboo language.  This is an informal sketch written as a preparation for the coming Coq or K code.\n\n## Overview\n\n### Arena of the Game\n\nA program written in Bamboo, once deployed, participates in a game between the program and the world.  In this game, the world makes the first move, the program makes the second move, and so on alternatively.  Neither the world or the program makes two moves in a row.  This document aims at  defining the choice of the program's move, given a sequence of earlier moves.\n\nThe world can make the following three kinds of moves:\n* calling the program\n* returning into the program\n* failing into the program\n\nThe program can make the following five kinds of moves:\n* calling an account\n* deploying code\n* returning\n* failing\n* destroying itself\n\nA sequence of moves can be equipped with a number called the nesting.\n\nThe empty sequence is associated with zero-nesting.  Initially, when the program is deployed, the program is not running (or running with zero-nesting).  When the program is not running, the world can only call the program.\n\nWhen the world calls the program, the nesting increases by one.  When the program returns, fails, or destroys itself, the nesting decreases by one.\n\nFrom the above sentences, you should be able to prove that the nesting never goes below zero.\n\n### Bamboo's Strategy\n\nIn general, a program needs to decide on a move after any sequence of moves that ends with the world's move.  However, Bamboo does not remember the whole sequence of moves, but just remembers the \"program's state\".  The Bamboo semantics computes the program's next move only using the stored program's state and the previous move made by the world.  In addition to the program's move, the Bamboo semantics specifies the program's new altered state for later use.\n\n### Bamboo's Program State\n\nThe program's state has three components: a persistent state, a `killed` flag, and pending execution states.  When the game is `n`-running, the program's state contains `n` pending execution states.\n\nA persistent state is either the special aborting element or a name of the contract followed by its arguments.\n\nIn the simple case, when the source code says\n```\ncontract A ()\n```\nthe persistent state can be simply `A()`.\n\n\nIn a more complicated example, when the source code says\n```\ncontract B (uint totalSupply)\n```\nthe program's state can be `B(0)`, `B(3000)` or `B(<any uint256 value>)`.  However, `B()` is not a program state.  `B(1,2)` is not a persistent state either because the number of arguments do not match the number of parameters in the source code.\n\n### An example of Persistent States\n\nLet's consider one Bamboo source code, which contains three contracts:\n```\ncontract A() {\n    default {\n        return then become B();\n    }\n}\ncontract B() {\n    default {\n        return then become C();\n    }\n}\ncontract C() {\n    default {\n        selfdestruct(this);\n    }\n}\n```\n\nWhen this source code is compiled and deployed, we get a program whose state consists of a persistent state and no pending execution states.  The initial persistent state is `A()`.  The initial `killed` flag is `false`.\n\nWhen the world calls the program, the program might return, leaving the persistent state `B()`; intuitively, that's the meaning of `return then become B()`.  Otherwise, there is a possibility that the program fails, leaving the persistent state as `A()` (this possibility comes from EVM's out-of-gas).\n\nWhen the world calls the program again, the program might return, leaving the persistent state `C()`; intuitively, that's the meaning of `return then become C()`. Otherwise, there is a possibility that the program fails, leaving the persistent state as `B()` (this possibility comes from EVM's out-of-gas).\n\nWhen the world calls the program again, the program might destroy itself.  This is described in `selfdestruct(this)`.  The form `selfdestruct(.)` takes one argument, which specifies the account where the remaining ETH balance goes.  The keyword `this` represents the Ethereum account where the program is deployed.  Bamboo inherits EVM's special behavior when the program's own address is specified as the receiver of the remaining balance.  In that case, the remaining balance disappears.  After selfdestruction, the program's state contains the `killed` flag `true`.  Again, there is a possibility that the program fails, leaving the persistent state as `C()` and the `killed` flag `false` (this possibility comes from EVM's out-of-gas).\n\n### What happens after selfdestruction\n\nAfter the program destroys itself, if the world calls the program, the program simply returns the empty data given enough gas.  The program might fail if there is not enough gas.  (TODO: make sure the compiler realizes this behavior.  Issue [#170](https://github.com/pirapira/bamboo/issues/170).)\n\n### What happens if the selfdestruction is reverted?\n\nPeople familiar with EVM semantics might ask what happens when state changes are reverted.  The Bamboo semantics do not see the state reversion.  From a history in the EVM, you can pick up unreverted executions, and the Bamboo semantics can run there.\n\n(TODO: maybe I should not mention the possibilities that the program fails because of out-of-gas in EVM?)\n\n## Pending Execution State\n\nAs mentioned, a program's state contains a list of pending execution states.  Moreover, after the world makes a move and before the program makes a move, the abstract machine keeps track of the current pending execution state.\n\nA pending execution state contains an evaluation point, a variable environment and an annotating function.  Each component is described below.\n\n### An evaluation point\n\nAny pending execution state contains an evaluation point.  An evaluation point is either a sentence or an expression in the source code.  When identical expressions (resp. sentences) appear in the source code, they are considered different expressions (resp. sentences) if their locations are different.\n\nA Bamboo source code is a list of contracts.  A contract contains a list of cases.  A case contains a list of sentences.  A sentence contains sentences and/or expressions.  An expression contains sentences and/or expressions.  The current evaluation point is either a sentence or an expression in the source code.  (TODO: there should be a separate document called Bamboo Syntax.)\n\n### A variable environment\n\nAny pending execution state contains a variable environment.  A variable environment is a finite map from identifiers to values.  (TODO: describe identifiers in a separate document Bamboo Syntax).\n\nA value is a sequence of 32 bytes.  When values are interpreted as numbers, they are encoded in big-endian.\n\nThe empty variable environment maps no identifiers to values.\n\n### An annotating function\n\nAny pending execution state contains an annotation function.  An annotation function is a finite map from expressions in the source code to values or persistent states.  In other words, given an expression in the source code, an annotation function gives nothing, a value, or a persistent state. When identically looking expressions appear in the source code, they are considered different if their locations are different.\n\nThe empty annotating function maps no expressions to values.\n\n## When the World calls the Program\n\nWhen the world calls the program, the world can specify one of the two kinds of calls: calling the default case or calling a named case.\n\nAnyway, when the world calls the program, the program first looks up the source code for the contract specified in the permanent state.  For example, when the permanent state is `A()`, the program tries to find a contract called `A` with zero arguments in the source code.  If such a contract is not found in the source code, the Bamboo compiler is broken.  If multiple such contracts are found in the compiler, the Bamboo compiler is also broken.\n\nMoreover, if the persistent state of the program contains `killed` flag being true, the program returns or fails at random (the EVM knows if there is enough gas to execute `STOP`, but the Bamboo semantics is not aware of the EVM's choice).\n\n### The world can call the default case\n\nIf such a contract is found in the source code, and if the world has called the default case, the program then looks for the `default` case in the contract.  If there is none, the program fails.  If there are more than one `default` case, the Bamboo compiler is broken.  If there is one such `default` case, the `default` case contains a list of sentences.  If the list of sentences is empty, the Bamboo compiler is broken.  Otherwise, the evaluation point is set to the first sentence in the list of sentences.\n\nThe combination of the evaluation point, the empty variable environment, and the empty annotating function is kept as the current pending execution state.\n\n### The world can call a named case\n\nWhen the world calls a named case, the world needs to specify an identifier (name of the case), a list of ABI types and a list of values.\n\nBamboo recognizes the following ABI types:\n* uint256\n* uint8\n* bytes32\n* address\n* bool\n\nThese types are just meaningless symbols.\n\nA value is a sequence of 32 bytes.\n\nWhen the world calls a named case, the program looks up the source code for the contract specified in the permanent state.  If the contract is not found, the Bamboo compiler is broken.  If multiple contracts are found matching the permanent state, the Bamboo compiler is also broken.\n\nThe program searches the contract in the source code for a case that matches the world's call.  For instance, when the world specified a named case `f(uint256, bool, address)`, the case `case (f (uint256 x, bool y, address z))` is a matching case.  When there are no cases that match the world's call, the program proceeds as if the world specified the default case.  If there are multiple cases that match the world's call, the Bamboo compiler is broken.\n\nThe case contains a list of sentences.  If the list is empty, the Bamboo compiler is broken.  Otherwise, the evaluation point is set to the first sentence in the list of sentences.  To clarify the first-last direction, the first sentence is the closest to the case's header.\n\nIf the world's call contains more values than ABI types, the program fails.  If the world's call contains fewer values than ABI types, the program also fails.  Otherwise, a variable environment is formed in a straightforward way (TODO: explain).\n\nThe combination of the evaluation point, the variable environment, and the empty annotating function is kept as the current pending execution state.\n\n## When there is a current pending execution state\n\nWhen there is a current pending execution state, there is always a possibility that the program fails immediately.  This is because of the underlying EVM mechanism can run out of gas, but Bamboo is not aware of this mechanism.  From this document's view, the program just fails at any moment randomly.\n\nMoreover, when the evaluation point in the current pending execution state is an `abort;` sentence, the program certainly fails.\n\nOtherwise, when the evaluation point in the current pending execution state is a `return then become X;` sentence, if the annotating function does not map `X` to anything, the evaluation point is set to `X`.  When the annotation function maps `X` to a persistent state, the program returns and leaves the persistent state specified by the annotation function.\n\nOtherwise, when the evaluation point in the current pending execution state is a `return e then become X;` sentence, if the annotating function does not map `X` to anything, the evaluation point is set to `X`. When the annotation function maps `X` to a persistent state, but the annotation function does not map `e` to anything, the evaluation point is set to `e`. When the annotation function maps `X` to a persistent state and the annotation function maps `e` to a value, the program returns the value associated with `e` and leaves the persistent state associated with `X`.  When the annotation function does anything else, the Bamboo compiler is broken.\n\nOtherwise, when the evaluation point in the current pending execution state is a `void = X;` sentence, if the annotating function does not map `X` to anything, the evaluation point is set to `X`.  Otherwise, the evaluation point advances from the sentence (see below for how an evaluation point advances from a sentence in the source code).\n\nOtherwise, when the evaluation point in the current pending execution state is a `TYPE V = X` where `TYPE` is a name of a type, `V` is an identifier and `X` is an expression, if the annotating function does not map `X` to anything, the evaluation point is set to `X`.  Otherwise, if the annotating function maps `X` to a value, the variable environment is updated to map `V` to the value, and the evaluation point advances from this sentence (see below for  what it is that the evaluation point advances).\n\nOtherwise, when the evaluation point in the current pending execution state is an `if (C) then B0 else B1` sentence, where `C` is an expression, `B0` is a block and `B1` is another block, the evaluation point is set to `C` if the annotating function does not map `C` to anything.  Otherwise, when the annotation function maps `C` to zero, the evaluation point advances into `B1` (see below for what it is that the evaluation point advances into a block).  Even otherwise, when the annotation function maps `C` to a non-zero value, the evaluation point advances into `B0`.  When the annotation function maps `C` to something else, the Bamboo compiler is broken.\n\nOtherwise, when the evaluation point in the current pending execution state is a `log E(e0, e1, ..., en)` sentence, if the annotation function maps any `ek` to nothing, the last such argument becomes the evaluation point.  Otherwise, the evaluation point moves advances from this sentence (see below for what it is for an evaluation point to advance).\n\nOtherwise, when the evaluation point in the current pending execution state is a `selfdestruct(X);` sentence, if the annotating function does not map `X` to anything, the evaluation point is set to `X`. When the annotating function maps `X` to a value, the program destroys itself, specifying the value as the inheritor.  The current pending execution state is discarded.  The `killed` flag is set in the persistent state.  (When the program has been called from a Bamboo program, the world then returns into that Bamboo program, not failing into it.)\n\nOtherwise, when the evaluation point in the current pending execution state is an identifier occurrence, the program looks up the variable environment. If the variable environment does not map the identifier occurrence to a value, the Bamboo compiler is broken.  Otherwise, when the variable environment maps the identifier occurrence to a value, the annotating function now associates the identifier occurrence with the value.  The evaluation point is set to the surrounding expression or sentence.\n\nOtherwise, when the evaluation point in the current pending execution state is a call `C.m(E1, E2, ...,E_n) reentrance { abort; }`, if the annotating function does not map `C` to anything, the evaluation point is set to `C`.  Otherwise, if the annotation function maps any of `E_k` to nothing, the evaluation point is set to the last such argument.  Otherwise, the program calls an account of address, specified by the annotation of `C`.  The call is on a named case `m` (TODO: for completing this clause, we need some information about the types of arguments of `m`.  We need some information in the persistent state), together with annotations of `E1`, ... `E_n`.  The program's state should now contain the current pending execution state as the last element in the list of pending execution states.  Moreover, the persistent state in the program's state is now the aborting element.\n\nOtherwise, when the evaluation point in the current pending execution state is a deployment `deploy C(E1, E2, E_n) reentrance { abort; }`, if the annotation function maps any of `E_k` to nothing, the evaluation point is set to the last such argument.  Otherwise, the program deploys the contract `C` with a packing of annotations of `E_k`s.  If the contract `C` does not appear in the source code, the Bamboo compiler is broken.  The program's state should now contain the current pending execution state as the last element in the list of pending execution states.  Moreover, the persistent state in the program's state is now the aborting element.\n\n## How to advance an evaluation point\n\nWhen an evaluation point advances from a sentence, if the sentence belongs to a case's body, and there is a next sentence, the next sentence becomes the evaluation point.  Otherwise, if the sentence belongs to a case's body but there is no next sentence, the Bamboo compiler has an error. Otherwise, when the sentence belongs to a block, and there is a next sentence, the next sentence becomes the evaluation point.  Otherwise, when the sentence belongs to a block and there is no next sentence, the evaluation point advances from the sentence containing the block.  Otherwise, when the sentence belongs to a sentence, the evaluation point advances from the containing sentence.\n\n## When the World returns into the Program\n\nWhen the world returns into the program but the program's state does not contain any pending execution state, something is very wrong.  Otherwise, the program finds in its state the last element in the list of pending execution states.  This element is removed from the program's state and becomes the current pending execution state.  The execution continues according to the execution point in the current pending execution state.\n\n## When the World fails into the Program\n\nThe program fails as well.\n\n## Adding Mappings\n\nSometimes, a contract contains a mapping.  For example, when a contract in the source code looks like\n```\nA(address => uint256 balances) { ... }\n```\nThe permanent state associates a value for `balances`.  Moreover, the permanent state contains a grand mapping that takes two values and return a value.  This grand mapping `M` is common to all mappings in the permanent state.  When `balances[3]` is looked up, actually, `M(<<balances>>, 3)` is looked up (where `<<balances>>` is the value that he permanent state associates to `balances`).  When a program is deployed, the grand mapping in the permanent state maps everything to zero.  Moreover, the permanent state contains a value called the array seed.\n\nWhen the program is deployed, the initial permanent state associates `balances` to one, and the array seed is two.  In general, when a contract contains `n` mappings, the initial permanent state associates these mappings to `1`, `2`, ..., `n`.  Moreover, the initial permanent state has the array seed `n + 1`.\n\nWhen the evaluation point is an assignment to a mapping `m[idx0][idx1]...[idx_k] = V`, the program looks up the annotating function for `m[idx0][idx1]...[idx_k - 1]`.  If the annotating function does not map this part to anything, `m[idx0][idx1]...[idx_k - 1]` becomes the evaluation point.  Otherwise, if the annotating function does not map `idx_k` to anything, `idx_k` becomes the evaluation point.  Otherwise, if the annotating function does not map `V` to anything, `V` becomes the evaluation point.  Otherwise, when all of these are mapped to some value, the grand mapping is updated to map the evaluation of `m[idx0]...[idx_k - 1]` and `idx_k` into the evaluation of `V`, and the evaluation point advances from the assignment sentence.\n\nWhen the evaluation point is a mapping lookup `m[idx]`, the program looks up the annotating function for `m`. If the annotating function does not map `m` to anything, `m` becomes the evaluation point.\nOtherwise, if the annotating function maps `m` to zero, the program assigns a seed to `m` (see below for what it is for a program to assign a seed to `m`).\nOtherwise, if the annotating function does not map `idx` to anything, the evaluation point becomes `idx`.\nOtherwise, the annotating function is updated to map `m[idx]` to `M(<<m>>, <<idx>>)` where `<<m>>` and `<<idx>>` are the values that the annotation function returns for `m` and `idx`, and the evaluation point is set to the surrounding expression or sentence.\n\nWhen the program assigns a new array seed to `m[idx]`, the grand mapping function is updated so that `M(<<m>>, <<idx>>)` is the array seed, where `<<m>>` and `<<idx>>` represents the values that the annotation function maps `m` and `idx` into.  Then, the array seed is incremented.  When the annotation function does not map `m` or `idx` to any value, the Bamboo compiler is broken.\n"
  },
  {
    "path": "doc/spec.tex",
    "content": "\\documentclass{book}\n\n\\usepackage{stmaryrd}\n\\usepackage{amsmath}\n\n\n\\newcommand{\\todo}[1]{\\underline{TODO: {#1}}}\n\\newcommand{\\sem}[1]{\\llbracket{#1}\\rrbracket}\n\\newcommand{\\evalE}[1]{E_\\mathrm{e}\\left({#1}\\right)}\n\\newcommand{\\evalS}[1]{E_\\mathrm{s}\\left({#1}\\right)}\n\n\\newcommand{\\expressionsentence}[1]{\\mathsf{void}={#1}\\mathsf{;}}\n\n\\title{Bamboo Specification---An Early Draft}\n\n\\begin{document}\n\n\\maketitle\n\nThis specification contains some exercises.  Please try to solve them at least mentally.  Your solutions are welcome at \\texttt{https://gitter.im/bbo-dev/Lobby}.  \\todo{use url}\n\n\\chapter{Preliminaries}\n\n\\section{What Qualifies a Bamboo Implementation}\n\n\\ldots A Bamboo compiler can refuse to compile certain valid programs.\n\n\\section{Notations}\n\n$v \\in A$ says $v$ is an element of a set~$A$.\n\n\\chapter{Syntax}\n\n\\section{Keywords}\n\n\\newcommand{\\abort}{\\text{\\texttt{abort;}}}\n\\newcommand{\\true}{\\text{\\texttt{true}}}\n\\newcommand{\\false}{\\text{\\texttt{false}}}\n\\newcommand{\\msgsender}{\\text{\\texttt{msg.sender}}}\n\\newcommand{\\msgvalue}{\\text{\\texttt{msg.value}}}\n\\newcommand{\\this}{\\text{\\texttt{this}}}\n\\newcommand{\\now}{\\text{\\texttt{now}}}\n\\newcommand{\\paren}[1]{\\mathtt{(}{#1}\\mathtt{)}}\n\\newcommand{\\logicalAnd}[2]{{#1}\\mathbin{\\text{\\texttt{\\&\\&}}{#2}}}\n\\newcommand{\\logicalNot}[1]{\\mathop{\\text{\\texttt{not}}}{#1}}\n\\newcommand{\\balance}[1]{\\text{\\texttt{balance}}\\mathtt{(}{#1}\\mathtt{)}}\n\\newcommand{\\arrayAccess}[2]{{#1}[{#2}]}\n\\newcommand{\\lt}[2]{{#1} \\mathop{\\text{\\texttt{<}}} {#2}}\n\\newcommand{\\gt}[2]{{#1} \\mathop{\\text{\\texttt{>}}} {#2}}\n\\newcommand{\\eq}[2]{{#1} \\mathop{\\text{\\texttt{==}}} {#2}}\n\\newcommand{\\notEq}[2]{{#1} \\mathop{\\text{\\texttt{!=}}} {#2}}\n\nThe following sequences of characters are \\textit{keywords}.\n\\begin{itemize}\n\\item $\\true$\n\\item $\\false$\n\\item $\\this$\n\\item $\\now$\n\\item \\texttt{not}\n\\item \\texttt{contract}\n\\item \\texttt{default}\n\\item \\texttt{case}\n\\item \\texttt{abort}\n\\item \\texttt{uint8}\n\\item \\texttt{uint256}\n\\item \\texttt{bytes32}\n\\item \\texttt{address}\n\\item \\texttt{bool}\n\\item \\texttt{if}\n\\item \\texttt{else}\n\\item \\texttt{then}\n\\item \\texttt{become}\n\\item \\texttt{return}\n\\item \\texttt{deploy}\n\\item \\texttt{with}\n\\item \\texttt{reentrance}\n\\item \\texttt{selfdestruct}\n\\item \\texttt{block}\n\\item \\texttt{void}\n\\item \\texttt{event}\n\\item \\texttt{log}\n\\item \\texttt{indexed}\n\\end{itemize}\n\n\\todo{Use a maththm like environment for exercises.}\n\nExercise: which of the following are keywords?\n\\begin{enumerate}\n\\item \\texttt{True}\n\\item \\texttt{true}\n\\end{enumerate}\n\n\\section{Identifier}\n\nAn \\textit{identifier} is a sequence of characters that matches the following regular expression (but is not a keyword):\n\\begin{verbatim}\n  ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']*\n\\end{verbatim}\n\n\\todo{define identifier}\n\n\nExercise: which of the following are identifiers? \\\\\n\\todo{complete}\n\n\\section{Syntactic Types}\n\nThe following sequences of characters are \\textit{syntactic types}.\n\\begin{itemize}\n\\item \\texttt{void}\n\\item \\texttt{uint256}\n\\item \\texttt{bool}\n\\item \\texttt{uint8}\n\\item \\texttt{bytes32}\n\\item \\texttt{address}\n\\item \\texttt{mapping } $T$ \\texttt{=>} $T'$ when $T$ and $T'$ are syntactic types\n\\item any identifier except those listed above.\n\\end{itemize}\n\nEvery syntactic type except \\texttt{void} is a \\textit{non-\\texttt{void} syntactic type}.\n\nExercise: which of the following is true?\n\\begin{enumerate}\n\\item \\texttt{uint256} is the set of integers at least zero and at most $2^{256} - 1$.\n\\item \\texttt{uint256} is the set of 256-bit words.\n\\item none of the above.\n\\end{enumerate}\n\n\\section{Expressions}\n\nA \\textit{message-info} is a value-info followed by a reentrance-info.\n\nA \\textit{case-call-expression} looks like\n\\[\ne . c (e_1, \\ldots, e_n)\\ m\n\\]\nwith $e$ and $e_i$ ($1 \\le i \\le n$) being expressions and $m$ a message-info.\n\nA \\textit{call-expression} is either a case-call-expression or a default-call-expression.\n\nA \\textit{deploy-expression} looks\n\\[\n\\text{\\texttt{deploy}}\\ i(e_1,\\ldots,e_n)\\ m\n\\]\nwith $i$ being an identifier, $e_i$ ($1 \\le i \\le n$) an expression and $m$ a message-info.\n\n\\textit{Expressions} are inductively defined as follows.\n\n\\begin{itemize}\n\\item $\\true$ is an expression.\n\\item $\\false$ is an expression.\n\\item $\\msgsender$ is an expression.\n\\item $\\msgvalue$ is an expression.\n\\item $\\this$ is an expression.\n\\item $\\now$ is an expression.\n\\item An identifier is an expression.\n\\item When $e$ is an expression, $\\paren{e}$ is an expression.\n\\item When $e$ is an expression, $\\logicalNot{e}$ is an expression.\n\\item When $e$ is an expression, $\\balance{e}$ is an expression.\n\\item A deploy-expression is an expression.\n\\item A call-expression is an expression.\n\\item AddressExp?  What is an AddressExp?\n\\item When $e_0$ and $e_1$ are expressions, the following are expressions\n\\begin{itemize}\n\\item $\\logicalAnd{e_0}{e_1}$\n\\item $\\lt{e_0}{e_1}$\n\\item $\\gt{e_0}{e_1}$\n\\item $\\notEq{e_0}{e_1}$\n\\item $\\eq{e_0}{e_1}$\n\\item $\\arrayAccess{e_0}{e_1}$\n\\item $e_0 + e_1$\n\\item $e_0 - e_1$\n\\item $e_0 \\times e_1$\n\\end{itemize}\n\\end{itemize}\n\nExercise: prove that \\texttt{99a} is not an expression.\n\n\\section{Sentences}\n\nA \\textit{return sentence} looks\n\\[\n\\texttt{return}\\, e_0 \\,\\texttt{then}\\, \\texttt{become}\\, i(e_1,\\ldots,e_n);\n\\]\nwith $i$ being an identifier and $e_i$ ($0 \\le i \\le n$) an expression.\n\nAn \\textit{assignment sentence} looks\n\\[\nl = e;\n\\]\nwith $l$ being a left-expression and $e$ an expression.\n\nA \\textit{variable initialization sentence} looks\n\\[\nt i = e;\n\\]\nwith $t$ being a type, $i$ and identifier and $e$ an expression.\n\nAn \\textit{expression sentence} looks\n\\[\n\\texttt{void}\\, = \\,e;\n\\]\nwith $e$ being an expression.\n\nAn \\textit{if sentence} looks\n\\[\n\\texttt{if}\\, (e)\\, B\n\\]\nwith $e$ being an expression and $B$ either a block or a sentence (this forms a mutual induction together with the definition of sentences).\n\nAn \\textit{if-then-else sentence} is looks\n\\[\n\\texttt{if}\\, (e)\\, B_0 \\,\\texttt{else}\\, B_1\n\\]\nwith $e$ being an expression and each $B_i$ either a block or a sentence (this forms a mutual induction together with the definition of sentences).\n\nA \\textit{logging sentence} looks\n\\[\n\\texttt{log}\\,i(e_1, \\ldots, e_n)\n\\]\nwhere $n \\ge 0$.  Each $e_j$ is an expression.  $i$ is an identifier.\n\nA \\textit{selfdestruct sentence} looks\n\\[\n\\texttt{selfdestruct}\\, e;\n\\]\nwith $e$ being an expression.\n\n\\textit{Sentences} are inductively defined as follows.\n\n\\begin{itemize}\n\\item $\\abort$ is a sentence.\n\\item a return sentence is a sentence.\n\\item an assignment sentnece is a sentence.\n\\item a variable initialization sentence is a sentence.\n\\item an expression sentence is a sentence.\n\\item an if sentence is a sentence.\n\\item an if-then-else sentence is a sentence.\n\\item a logging sentence is a sentence.\n\\item a self-destruct sentence is a sentence.\n\\end{itemize}\n\n\\section{Blocks}\n\nA \\textit{block} is a possibly empty sequence of stentences surrounded by \\texttt{\\{} and \\texttt{\\}}.\n\n\\todo{talk about whitespaces, perhaps.}\n\n\\section{Cases}\n\nA \\textit{case header} is either a default case header or a named case header.\n\nA \\textit{case} is a case header followed by a block.\n\n\n\\section{Contract Headers}\n\nA \\textit{contract header} looks\n\\[\n \\mathtt{contract} i(t_1 i_1, \\ldots, t_n i_n);\n\\]\nwhere $i$ and $i_j$ ($1 \\le j \\le n$) are identifiers, $t_j$ ($1 \\le j \\le n$) are syntactic types.\n\n\\section{Contracts}\n\nA \\textit{contract} is a contract header followed by a \\texttt{\\{}, some (possibly no) cases and a \\texttt{\\}}.\n\n\\subsection{Contract's Signature}\n\n$(\\mathtt{auction}, [\\mathtt{address}, \\mathtt{uint256}, \\mathtt{address}, \\mathtt{uint256}])$.\n\nExercise: what is the signature of the following contract?\n\\todo{complete the question}\n\n\\subsection{Contract Body}\n\nA \\textit{contract body} is a possibly empty sequence of cases surrounded by \\texttt{\\{} and \\texttt{\\}}.\n\n\\subsection{Contract Definitions}\n\nA \\textit{contract definition} is a contract header followed by a contract body.\n\n\\section{Event Declarations}\n\nAn \\textit{event declaration} looks like\n\\[\n i(e_1, \\ldots, e_n);\n\\]\nwhere $n \\ge 0$, each $e_j$ is an event argument, and $i$ is an identifier.\n\n\\section{Program}\n\nA \\textit{program} is a possibly empty sequence of contract definitions and event declarations.\n\n\\chapter{Semantics}\n\n\\section{Notations}\n\n\\todo{describe $\\in$}\n\n\\todo{describe pi}\n\n\\section{States}\n\n\\subsection{Values}\n\nA \\textit{value} is a 256-bit word.\n\nWe pick something called $\\bot$ (pronounced ``bottom'') which is not a value.  The choice should not affect the meaning of a Bamboo program.\n\n(We might specify a set of values for each syntactic type in the future.)\n\n\\subsection{A Contract's States}\nA contract has \\textit{states}.\n\nWhen a contract has a signature $(x, [T_1, T_2, \\ldots, T_n])$ ($n \\ge 0$),\nthe set of the states of the contract~$C$ is\n$[[C]] \\equiv \\Pi_{i = 0}^{n} \\sem{T_i}$.\n\n\\subsection{A Program's Account States}\nA program determines a set of \\textit{account states}.\n\nA program contains contract definitions $C_1, \\ldots, C_n$ ($n \\ge 0$),\ndisjoint union of $[[C_i]]$ ($1 \\le i \\le n$).\n\n\\section{Dynamics}\n\n\\subsection{Variable Environment}\n\nA \\textit{variable environment} is a partial map that takes identifiers and may or may not return a value.  When a variable environment $\\sigma$ maps and identifier~$i$ to a value~$v$, we write\n\\[\n\\sigma(i) = v\n\\]\n\n\\subsection{Current Call}\n\nA \\textit{current call} $c = (c_\\mathrm{s}, c_\\mathrm{v}, c_\\mathrm{t})$ is a tuple of\n\\begin{itemize}\n\\item a value $c_\\mathrm{s}$ called the \\textit{sender},\n\\item a value $c_\\mathrm{v}$ called the \\textit{transferred amount} and\n\\item a value $c_\\mathrm{t}$ called the \\textit{timestamp}.\n\\end{itemize}\n\n\\subsection{World Oracle}\n\n\\subsubsection{Call Queries}\n\n\\subsubsection{Create Queries}\n\n\\subsubsection{Balance Queries}\n\n\\subsection{Timestamp query}\n\n\\newcommand{\\timestampQuery}{\\text{\\texttt{timestamp?}}}\nThe time stamp query~$\\timestampQuery$ is something different from any query that appears above. Apart from that, $\\timestampQuery$ can be anything, and the behavior of Bamboo programs should not be affected by the concrete choice of $\\timestampQuery$ (with some adaptations on world oracles).\n\n\\subsection{Current Account Query}\n\n\\newcommand{\\thisQuery}[0]{\\text{\\texttt{this?}}}\n\nThe current account query~$\\thisQuery$ is something different from any query that appears above.\n\n\\subsection{Sender Query}\n\n\\newcommand{\\senderQuery}{\\text{\\texttt{sender?}}}\n\nThe sender query~$\\senderQuery$ is something different from any query that appears above.\n\n\\subsection{Value Query}\n\n\\newcommand{\\valueQuery}{\\text{\\texttt{value?}}}\n\nThe value query~$\\valueQuery$ is something different from any query that appears above.\n\n\\subsubsection{World Oracle}\n\nCall queries, create queries, \\todo{fill in} are \\textit{oracle queries}.\n\nA \\textit{world oracle} is defined coinductively as a function that takes an oracle query and returns a pair of a value and a world oracle.\n\nWhen a world oracle~$w$ takes a query~$q$ and returns a pair of a value~$v$ and a world oracle~$w'$, we write $w(q) = (v, w')$.\n\n\\todo{Add a possibility that the world oracle calls into the program again.}\n\n\\subsection{Evaluation of an Expression}\n\nThe evaluation for expressions takes\n\\begin{itemize}\n\\item an expression,\n\\item a current call,\n\\item a world oracle and\n\\item a variable environment.\n\\end{itemize}\nIt returns\n\\begin{itemize}\n\\item a value or $\\bot$ and\n\\item a world oracle\n\\end{itemize}\n\n\n\n\\todo{say it's inductively defined over the definition of expressions}.\n\n\\subsubsection{Evaluation of Literals}\n\n\\textit{Literals} are those keywords whose evaluation is defined below.\n\n\\begin{itemize}\n  \\item $\\evalE{\\boxed{\\true}, c, w, \\sigma} := (1, w)$\n  \\item $\\evalE{\\boxed{\\false}, c, w, \\sigma} := (0, w)$\n  \\item $\\evalE{\\boxed{\\now}, c, w, \\sigma} := w(\\timestampQuery)$\n  \\item $\\evalE{\\boxed{\\this}, c, w, \\sigma} := w(\\thisQuery)$\n  \\item $\\evalE{\\boxed{\\msgsender}, c, w, \\sigma} := w(\\senderQuery)$\n  \\item $\\evalE{\\boxed{\\msgvalue}, c, w, \\sigma} := w(\\valueQuery)$\n\\end{itemize}\n\nbalance(x) sends a balance query on the world oracle.\n\n\\subsubsection{Evaluation of an Identifier}\n\nAn identifier~$i$ is evaluated as follows:\n\\[\n\\evalE{\\boxed{i}, c, w, \\sigma} := (\\sigma(i), w)\n\\]\n\nNote that $\\sigma(i)$ can be $\\bot$.\n\n\\subsubsection{Evaluation of a new-expression}\n\n\\todo{Consider new-expressions with nontrivial continuation later.  That requires an interaction between the program and the world oracle. }\n\n\\subsubsection{Evaluation of a call-expression}\n\n\\todo{Consider call-expressions with nontrivial continuation later.  That requires an interaction between the program and the world oracle. }\n\n\\subsubsection{Evaluation of Binary Operators}\n\n\\[\n\\evalE{\\boxed{\\logicalAnd{e_0}{e_1}}, c, w, \\sigma} :=\n\\begin{cases}\n  (v_0, w_0) & \\text{if}\\ v_0 = 0\\ \\text{or}\\ v_0 = \\bot \\\\\n  (v_1, w_1) & \\text{otherwise}\n\\end{cases}\n\\]\nwhere\n\\[\n\\evalE{\\boxed{e_0}, c, w, \\sigma} = (v_0, w_0)\n\\]\nand\n\\[\n\\evalE{\\boxed{e_1}, c, w_0, \\sigma} = (v_1, w_1)\n\\]\n\n\\[\n\\evalE{\\boxed{\\lt{e_0}{e_1}}, c, w, \\sigma} :=\n\\begin{cases}\n  (1, w_0) &\\text{if}\\ v_0 \\neq \\bot, v_1 \\neq\\bot\\ \\text{and}\\ v_0 < v_1 \\\\\n  (0, w_0) &\\text{if}\\ v_0 \\neq \\bot, v_1 \\neq\\bot\\ \\text{and}\\ v_0 \\ge v_1 \\\\\n  (\\bot, w) &\\text{if}\\ v_0 = \\bot \\ \\text{or}\\ v_1 = \\bot\n\\end{cases}\n\\]\nwhere\n\\[\n\\evalE{\\boxed{e_1}, c, w, \\sigma} = (v_1, w_1)\n\\]\nand\n\\[\n\\evalE{\\boxed{e_0}, c, w, \\sigma} = (v_0, w_0)\n\\]\n\n\\[\n\\evalE{\\boxed{\\arrayAccess{e_0}{e_1}}, c, w, \\sigma, M} :=\n(w_0, M(v_0, v_1))\n\\]\nwhere\n\\[\n\\evalE{\\boxed{e_1}, c, w, \\sigma, M} = (v_1, w_1)\n\\]\nand\n\\[\n\\evalE{\\boxed{e_0}, c, w_1, \\sigma, M} = (v_0, w_0)\n\\]\n\n\\subsection{Evaluation of a Sentence}\n\nThe evaluation function for sentences take\n\\begin{itemize}\n\\item a sentence,\n\\item a current call,\n\\item a variable environment and\n\\item a world oracle\n\\end{itemize}\nand returns\n\\begin{itemize}\n\\item a variable environment,\n\\item a world oracle\n\\item and optionally an account state.\n\\end{itemize}\n\n\\todo{Show two forms of equations: one without an account state, the other with an account state.}\n\n\\subsubsection{Evaluation of an Expression Sentence}\n\n\\[\n\\evalS{\\boxed{\\expressionsentence{e}}, c, \\sigma, w} := (\\sigma', w')\n\\]\nwhere\n\\[\n\\evalE{\\boxed{e}, c, \\sigma, w} = (v, \\sigma', w')\n\\]\n\n\\subsection{Evaluation of a Case}\n\nThe evaluation function of a case takes\n\\begin{itemize}\n\\item A contract state\n\\item a world oracle\n\\item a case call\n\\end{itemize}\nand returns\n\\begin{itemize}\n\\item an account state\n\\item a world oracle\n\\end{itemize}\n\n\\subsection{Evaluation of a Contract}\n\nThe evaluation function of a contract takes\n\\begin{itemize}\n\\item A contract state\n\\item a world oracle\n\\item a contract call\n\\end{itemize}\nand returns\n\\begin{itemize}\n\\item An account state\n\\item a world oracle\n\\end{itemize}\n\n\\subsection{Evaluation of a Program}\n\nThe evaluation function of a program takes\n\\begin{itemize}\n\\item an account state\n\\item a world oracle\n\\item a program call\n\\end{itemize}\nand returns\n\\begin{itemize}\n\\item an account state\n\\item a world oracle\n\\end{itemize}\n\n\\section{Account Initialization}\n\n\\subsection{Account Deployment Query}\n\n\\subsection{Initial Variable Environment}\n\n\\chapter{Connection to EVM}\n\n\\section{Bamboo Account State as an EVM Account State}\n\n\\section{Queries as EVM instructions}\n\n\\end{document}\n"
  },
  {
    "path": "doc/testing-bytecode.md",
    "content": "Testing the Bytecode from bbo\n=============================\n\nGetting a Bytecode\n------------------\n\nAfter following the [readme](../README.md),\n\n```\n./lib/bs/native/bamboo.native < src/parse/examples/006auction_first_case.bbo\n```\nshould produce something like\n```\n0x60606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f37f000000000000000000000000000000000000000000000000000000000000000054565b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004507f0000000000000000000000000000000000000000000000000000000000000075565b7f00000000000000000000000000000000000000000000000000000000000000237f000000000000000000000000000000000000000000000000000000000000000055347f0000000000000000000000000000000000000000000000000000000000000005547f0000000000000000000000000000000000000000000000000000000000000003547f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f0000000000000000000000000000000000000000000000000000000000000005557f00000000000000000000000000000000000000000000000000000000000000045560016020807f000000000000000000000000000000000000000000000000000000000000004080518092019052918152f360606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f3\n```\n\nAppend Arguments\n----------------\n\nThe [source](../src/parse/examples/006auction_first_case.bbo) shows the signature of the contract.\n```\ncontract auction\n  (address _beneficiary\n  ,uint _bidding_time\n  ,bool[address] _bids\n  ,uint _highest_bid)\n```\nOf the four arguments, the three non-array arguments `_beneficiary`, `_bidding_time` and `_highest_bid` need to be specified.  Each of them take 32 bytes (even when it's an address that requires just 20 bytes).  Append the arguments to the bytecode, and you will get something like\n\n```\n0x60606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f37f000000000000000000000000000000000000000000000000000000000000000054565b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004507f0000000000000000000000000000000000000000000000000000000000000075565b7f00000000000000000000000000000000000000000000000000000000000000237f000000000000000000000000000000000000000000000000000000000000000055347f0000000000000000000000000000000000000000000000000000000000000005547f0000000000000000000000000000000000000000000000000000000000000003547f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f0000000000000000000000000000000000000000000000000000000000000005557f00000000000000000000000000000000000000000000000000000000000000045560016020807f000000000000000000000000000000000000000000000000000000000000004080518092019052918152f360606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f30x60606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f37f000000000000000000000000000000000000000000000000000000000000000054565b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004507f0000000000000000000000000000000000000000000000000000000000000075565b7f00000000000000000000000000000000000000000000000000000000000000237f000000000000000000000000000000000000000000000000000000000000000055347f0000000000000000000000000000000000000000000000000000000000000005547f0000000000000000000000000000000000000000000000000000000000000003547f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f0000000000000000000000000000000000000000000000000000000000000005557f00000000000000000000000000000000000000000000000000000000000000045560016020807f000000000000000000000000000000000000000000000000000000000000004080518092019052918152f360606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000200000000000000000000000000000000000000000000000000000000000000000\n```\n\nIn this hex notation, 32 bytes are represented by 64 characters.\n\nTesting the Contract on a Testnet\n---------------------------------\n\nCheckout [go-ethereum](https://github.com/ethereum/go-ethereum) and build it.\n```\n> git clone https://github.com/ethereum/go-ethereum\n> cd go-ethereum\n> make\n```\nYou might need to install [Go](https://golang.org).\n\nAnd you can run something like\n```\nbuild/bin/geth --testnet console --fast --bootnodes \"enode://20c9ad97c081d63397d7b685a412227a40e23c8bdc6688c6f37e97cfbc22d2b4d1db1510d8f61e6a8866ad7f0e17c02b14182d37ea7c3c8b9c2683aeb6b733a1@52.169.14.227:30303,enode://6ce05930c72abc632c58e2e4324f7c7ea478cec0ed4fa2528982cf34483094e9cbc9216e7aa349691242576d552a2a56aaeae426c5303ded677ce455ba1acd9d@13.84.180.240:30303\"\n```\n\nBelow, everything is in the console of `geth`.\n\nCheck if you already have an account:\n```\n> eth.accounts\n```\n\nIf you have no accounts, create one:\n\n```\n> personal.newAccount()\n```\nto create an account.\n\n```\nminer.start(2)\n```\nto start mining.  Leave the machine for half an hour.\n\nIf\n```\n> eth.getBalance(eth.accounts[0])\n```\nshows some non-zero number, you are ready to continue.\n\nI chose to perform the concatenation in the `geth` console.\n```\nvar data = \"0x60606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f37f000000000000000000000000000000000000000000000000000000000000000054565b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004507f0000000000000000000000000000000000000000000000000000000000000075565b7f00000000000000000000000000000000000000000000000000000000000000237f000000000000000000000000000000000000000000000000000000000000000055347f0000000000000000000000000000000000000000000000000000000000000005547f0000000000000000000000000000000000000000000000000000000000000003547f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f0000000000000000000000000000000000000000000000000000000000000005557f00000000000000000000000000000000000000000000000000000000000000045560016020807f000000000000000000000000000000000000000000000000000000000000004080518092019052918152f360606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f3\"\n```\n\n```\nvar data = data+\"0000000000000000000000000000000000000000000000000000000000000000\"+\"0000000000000000000000000000000000000000000000000000000400000020\"+\"0000000000000000000000000000000000000000000000000000000000000000\"\n```\n\nNow I can deploy the contract.\n```\nvar tx = eth.sendTransaction({from: eth.accounts[0], data: data, gas: 1000000})\n```\n\nAfter doing this, it takes some time until you see\n\n```\n> eth.getTransactionReceipt(tx)\n{\n  blockHash: \"0x21ad6127030275d8ec0e0e0c6291e4a9e4a571c00e961f88e385dedeae930487\",\n  blockNumber: 1197013,\n  contractAddress: \"0x56d9ffea1224a661fc63855994638efebbf2c92b\",\n  cumulativeGasUsed: 382585,\n  from: \"0xe64ae430b97ff403a194e214175c4144a82969f4\",\n  gasUsed: 382585,\n  logs: [],\n  logsBloom: \"0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\n  root: \"0xb50914b39a58ef18700766cb8f49753447dee0f70a01443b5a15479908940753\",\n  to: null,\n  transactionHash: \"0xd480e58ceed4e6f2950f45ba7eec1ac9068799d6a49ecc62db97f152da2d79cb\",\n  transactionIndex: 0\n}\n```\n\nAnd then, you can get the address of the deployed contract.\n```\n> var contract = eth.getTransactionReceipt(tx).contractAddress\n```\n\nIndeed, there is code.\n```\n> eth.getCode(contract)\n\"0x7f000000000000000000000000000000000000000000000000000000000000000054565b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004507f0000000000000000000000000000000000000000000000000000000000000075565b7f00000000000000000000000000000000000000000000000000000000000000237f000000000000000000000000000000000000000000000000000000000000000055347f0000000000000000000000000000000000000000000000000000000000000005547f0000000000000000000000000000000000000000000000000000000000000003547f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f0000000000000000000000000000000000000000000000000000000000000005557f00000000000000000000000000000000000000000000000000000000000000045560016020807f000000000000000000000000000000000000000000000000000000000000004080518092019052918152f360606040527f0000000000000000000000000000000000000000000000000000000000000060807f0000000000000000000000000000000000000000000000000000000000000040805180920190528180380382397f00000000000000000000000000000000000000000000000000000000000000025b82157f000000000000000000000000000000000000000000000000000000000000012c57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f000000000000000000000000000000000000000000000000000000000000002001907f0000000000000000000000000000000000000000000000000000000000000076565b5050506001547f000000000000000000000000000000000000000000000000000000000000015957600180555b600154806300000005557f0000000000000000000000000000000000000000000000000000000000000001016001557f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000000414807f000000000000000000000000000000000000000000000000000000000000004080518092019052817f000000000000000000000000000000000000000000000000000000000000023b8239f3\"\n```\n\nAnd the arguments are stored in a straight-forward way\n```\n> eth.getStorageAt(contract, 2)\n\"0x0000000000000000000000000000000000000000000000000000000000000000\"\n> eth.getStorageAt(contract, 3)\n\"0x0000000000000000000000000000000000000000000000000000000000000020\"\n> eth.getStorageAt(contract, 4)\n\"0x0000000000000000000000000000000000000000000000000000000000000000\"\n```\n\nYou can send another transaction to invoke the `default` case\n```\neth.sendTransaction({from: eth.accounts[0], to: contract, data: \"\", value: 100})\n```\n\nAfter a while, you see that the storage has changed.\n\n```\n> eth.getStorageAt(contract, 4)\n\"0x0000000000000000000000000000000000000000000000000000000000000064\"\n```\n"
  },
  {
    "path": "doc/tutorial.md",
    "content": "# Bamboo 0.0.01 Tutorial\n\nThis document covers\n* installation of the Bamboo compiler\n* compilation and deployment of a Bamboo program\n* interaction with the deployed Ethereum contract\n\n## Installing the Bamboo compiler\nMake sure OCaml 4.04 is installed\n```\n$ ocaml --version\nThe OCaml toplevel, version 4.04.2\n```\nIf a newer version is installed get the old one [here](http://ocaml.org/releases/4.04.html)\n\nThe Bamboo compiler can be installed with the OCaml package manager `opam`.\n\nIf you don't have it yet, get `opam` by\n* `apt-get install opam`\n* `brew install opam`\n* or one of [many other ways](https://opam.ocaml.org/doc/Install.html)\n\nAfter installing `opam`, run `opam init` and follow the instructions.\n\nWhen `opam` is ready, `opam install bamboo` gets you the Bamboo compiler.\n\n```\n$ bamboo --version\n0.0.01\n```\n\nIf anything goes wrong, poke @pirapira on [the Gitter channel](https://gitter.im/bbo-dev).\n\n## Compiling Bamboo code\n\nLet's deploy [this ERC20 contract](https://github.com/pirapira/bamboo/blob/master/src/parse/examples/01b_erc20better.bbo) on the Ropsten test network.\n\n```\n$ wget https://raw.githubusercontent.com/pirapira/bamboo/master/src/parse/examples/01b_erc20better.bbo\n```\nwill get you a file `01b_erc20better.bbo`.  You can have a look now, but I'll explain the contents when we interact with the contract.\n\nNow,\n```\n$ bamboo < 01b_erc20better.bbo > compiled.hex\n```\nshould store something in `compiled.hex` file.  You can have a look.  If you use it for anything serious, you should investigate `compiled.hex` here.  Since we are just playing on the test network, we go ahead deploying the compiled code.\n\nAlso,\n```\n$ bamboo --abi < 01b_erc20better.bbo > abi.json\n```\nwill get you a JSON file `abi.json` that describes the interface of this Ethereum contract.\n\n## Deploying on the Ropsten test network\n\nThe Ropsten network is a test network for Ethereum.  The balances and accounts are cleared sometimes.  In this tutorial we deploy the code to Ropsten.\n\n### Connecting go-ethereum to the Ropsten network\n\nWe use `go-ethereum`.  [Install go-ethereum](https://ethereum.github.io/go-ethereum/install/) somehow and run\n```\n$ build/bin/geth console --testnet --fast --bootnodes \"enode://20c9ad97c081d63397d7b685a412227a40e23c8bdc6688c6f37e97cfbc22d2b4d1db1510d8f61e6a8866ad7f0e17c02b14182d37ea7c3c8b9c2683aeb6b733a1@52.169.14.227:30303,enode://6ce05930c72abc632c58e2e4324f7c7ea478cec0ed4fa2528982cf34483094e9cbc9216e7aa349691242576d552a2a56aaeae426c5303ded677ce455ba1acd9d@13.84.180.240:30303\"\n```\n\nWhen you are still seeing something like\n```\nINFO [08-02|14:00:28] Imported new chain segment               blocks=119 txs=324 mgas=130.952 elapsed=8.008s    mgasps=16.352 number=1375400 hash=cd3c3f…a39ed3\n```\nwith `blocks=119` or some big numbers, `go-ethereum` has not synced yet.\n\nWhen it's synced, you will be seeing `blocks=1`\n```\nINFO [08-02|14:22:16] Imported new chain segment               blocks=1    txs=0    mgas=0.000   elapsed=13.958ms  mgasps=0.000   number=1417137 hash=8603a5…1de724\n```\n\n### Creating an account\n\nFor deploying code on the Ropsten network, you need an account.  If you don't have one, you can create it by typing\n\n```\n> personal.newAccount()\n```\n\ninto the geth console.\n\n### Earning some Ropsten test Ether\n\nFor deploying code on the Ropsten network, you also need Ropsten Ether.  You can either mine it, or get it from somebody else.\n\nYou can check your first account's balance by\n```\n> eth.getBalance(eth.accounts[0])\n2991644430772416863\n```\nin the geth console.  If it shows zero, there are ways to earn Ropsten Ether.\n\n#### Option 1. mining\n\nYou can start mining Ropsten Ether\n```\n> miner.start(2)\n```\n\nUsually you will get some Ropsten Ether within some hours.\n\nWhen you have some non-zero number, you can stop the mining by\n\n```\n> miner.stop()\n```\non the geth console.\n\n#### Option 2. asking\n\nIf you know somebody with Ropsten Ether, you can tell them your address created above, and ask them to send you some Ropsten Ether.\n\nYou can find your address by typing\n```\n> eth.accounts[0]\n```\n\n### Preparing the code and the ABI\n\nNow you can give a name to the hex code in `compiled.hex`.\n\n```\n> var code = \"0x60606040527f0000000000000000000000000000000000000000000000000000000000000020806040805180920190528180380382397f0000000000000000000000000000000000000000000000000000000000003dd13814156002577f00000000000000000000000000000000000000000000000000000000000000025b821563000000fc57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f00000000000000000000000000000000000000000000000000000000000000200190630000007e565b505050600154630000010d57600180555b6300000003630000014857600154806300000003557f0000000000000000000000000000000000000000000000000000000000000001016001555b6300000004630000018357600154806300000004557f0000000000000000000000000000000000000000000000000000000000000001016001555b7f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000003b9a80604080518092019052817f00000000000000000000000000000000000000000000000000000000000002178239f37f000000000000000000000000000000000000000000000000000000000000000054565b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004507f0000000000000000000000000000000000000000000000000000000000000075565b7f000000000000000000000000000000000000000000000000000000000000000254307f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000012c57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020557f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000020f57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000002a357507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455005b60606040527f00000000000000000000000000000000000000000000000000000000000000003560e060020a9004806318160ddd147f00000000000000000000000000000000000000000000000000000000000004a857806370a08231147f00000000000000000000000000000000000000000000000000000000000006da578063a9059cbb147f0000000000000000000000000000000000000000000000000000000000000997578063095ea7b3147f00000000000000000000000000000000000000000000000000000000000012e8578063dd62ed3e147f000000000000000000000000000000000000000000000000000000000000178e57806323b872dd147f0000000000000000000000000000000000000000000000000000000000001b45578063d96a094a147f0000000000000000000000000000000000000000000000000000000000002867578063d79875eb147f000000000000000000000000000000000000000000000000000000000000301057506002565b63000000043614156000577f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000058a57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000061e57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f0000000000000000000000000000000000000000000000000000000000000004557f00000000000000000000000000000000000000000000000000000000000000025460208060408051809201905291825290f35b63000000243614156000577f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f00000000000000000000000000000000000000000000000000000000000007bc57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000085057507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000097957507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205460208060408051809201905291825290f35b6300000044361415600057630000002435337f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000a3d57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205410156300000a55576002565b630000001035606060020a90043314156300000c9857333363ddf252ad630000002435602080604080518092019052918252909060006000500190a37f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000000b6857507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000bfc57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f35b630000002435337f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000d3357507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205403337f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000dd557507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000e8257507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054630000002435630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000f3557507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020540110156300000f4e576002565b630000002435630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000000ff557507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205401630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000010a357507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000001035606060020a90043363ddf252ad630000002435602080604080518092019052918252909060006000500190a37f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f00000000000000000000000000000000000000000000000000000000000011b857507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000124c57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f35b6300000044361415600057630000002435337f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000138e57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054101563000013a6576002565b630000001035606060020a900433141563000013c0576002565b630000002435630000001035606060020a9004337f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000146857507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020548063000015495750337f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000151157507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000001035606060020a900433638c5be1e5630000002435602080604080518092019052918252909060006000500190a37f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000165e57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000016f257507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f35b63000000443614156000577f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000187057507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000190457507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455630000003035606060020a9004630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000001a3a57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054806300001b275750630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000001aef57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205460208060408051809201905291825290f35b6300000064361415600057630000004435630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000001bf757507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205410156300001c0f576002565b63000000443533630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000001cb757507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054806300001da45750630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000001d6c57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205410156300001dbc576002565b630000003035606060020a9004630000001035606060020a90041415630000202357630000003035606060020a9004630000001035606060020a900463ddf252ad630000004435602080604080518092019052918252909060006000500190a37f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000001ef357507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000001f8757507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f35b630000004435630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000020ca57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205403630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000217857507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205563000000443533630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000222c57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020548063000023195750630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f00000000000000000000000000000000000000000000000000000000000022e157507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020540333630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f00000000000000000000000000000000000000000000000000000000000023c857507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020548063000024b55750630000001035606060020a90047f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000247d57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000004435630000003035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000256857507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205401630000003035606060020a90047f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000261657507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000003035606060020a9004630000001035606060020a900463ddf252ad630000004435602080604080518092019052918252909060006000500190a37f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000273757507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000027cb57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f35b6300000024361415600057630000000435307f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000290d57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205410156300002925576002565b337f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000029ba57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054630000000435337f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002a6157507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020540110156300002a7a576002565b3430310334630000000435307f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002b1a57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054030263000000043530310211156300002b3d576002565b630000000435307f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002bd857507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205403307f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002c7a57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000000435337f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002d2157507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205401337f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002dc357507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205533631cbc5ab1630000000435602080604080518092019052918252909034602080604080518092019052918252909060006000500190500190a27f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f0000000000000000000000000000000000000000000000000000000000002ee057507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f0000000000000000000000000000000000000000000000000000000000002f7457507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f35b630000004436141560005763000000243530311015630000302f576002565b630000000435337f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000030ca57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054101563000030e2576002565b307f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000317757507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054630000000435307f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000321e57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020540110156300003237576002565b341515156300003245576002565b3031630000002435303103630000000435307f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000032eb57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002054016300000024358102630000000435830210156300003314576002565b80307f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000033aa57507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b600052602052604060002055630000000435337f000000000000000000000000000000000000000000000000000000000000000354807f000000000000000000000000000000000000000000000000000000000000345157507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b60005260205260406000205403337f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000034f357507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b6000526020526040600020553363ed7a144f6300000004356020806040805180920190529182529090630000002435602080604080518092019052918252909060006000500190500190a26000546000805560008081818181630000002435336300000bb85a03f1156000579160005550507f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f000000000000000000000000000000000000000000000000000000000000000454807f000000000000000000000000000000000000000000000000000000000000363c57507f0000000000000000000000000000000000000000000000000000000000000004600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f000000000000000000000000000000000000000000000000000000000000000354807f00000000000000000000000000000000000000000000000000000000000036d057507f0000000000000000000000000000000000000000000000000000000000000003600154807f0000000000000000000000000000000000000000000000000000000000000001016001558091555b7f0000000000000000000000000000000000000000000000000000000000000002547f0000000000000000000000000000000000000000000000000000000000000002557f0000000000000000000000000000000000000000000000000000000000000003557f000000000000000000000000000000000000000000000000000000000000000455600160208060408051809201905291825290f360606040527f0000000000000000000000000000000000000000000000000000000000000020806040805180920190528180380382397f0000000000000000000000000000000000000000000000000000000000003dd13814156002577f00000000000000000000000000000000000000000000000000000000000000025b821563000000fc57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f00000000000000000000000000000000000000000000000000000000000000200190630000007e565b505050600154630000010d57600180555b6300000003630000014857600154806300000003557f0000000000000000000000000000000000000000000000000000000000000001016001555b6300000004630000018357600154806300000004557f0000000000000000000000000000000000000000000000000000000000000001016001555b7f00000000000000000000000000000000000000000000000000000000000000237f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000003b9a80604080518092019052817f00000000000000000000000000000000000000000000000000000000000002178239f360606040527f0000000000000000000000000000000000000000000000000000000000000020806040805180920190528180380382397f0000000000000000000000000000000000000000000000000000000000003dd13814156002577f00000000000000000000000000000000000000000000000000000000000000025b821563000000fc57815181557f0000000000000000000000000000000000000000000000000000000000000020909203917f000000000000000000000000000000000000000000000000000000000000000101907f00000000000000000000000000000000000000000000000000000000000000200190630000007e565b505050600154630000010d57600180555b6300000003630000014857600154806300000003557f0000000000000000000000000000000000000000000000000000000000000001016001555b6300000004630000018357600154806300000004557f0000000000000000000000000000000000000000000000000000000000000001016001555b7f000000000000000000000000000000000000000000000000000000000000032d7f0000000000000000000000000000000000000000000000000000000000000000557f0000000000000000000000000000000000000000000000000000000000003b9a80604080518092019052817f00000000000000000000000000000000000000000000000000000000000002178239f3\"\n```\n\nNow console session remembers the code.\n```\n> code\n```\nshould show the same string.\n\n(If you don't want to copy-and-paste strings, probably you should look at the [web3](https://github.com/ethereum/web3.js/) library.)\n\nAlso, we can store the abi in `abi.json`.\n```\nvar abi = [{\"type\": \"constructor\", \"inputs\":[{\"name\": \"totalSupply\", \"type\": \"uint256\"}], \"name\": \"PreToken\", \"outputs\":[], \"payable\": true},{\"type\":\"fallback\",\"inputs\": [],\"outputs\": [],\"payable\": true},{\"type\":\"event\",\"inputs\":[{\"name\":\"_from\",\"type\":\"address\",\"indexed\":true},{\"name\":\"_to\",\"type\":\"address\",\"indexed\":true},{\"name\":\"_amount\",\"type\":\"uint256\",\"indexed\":false}],\"name\":\"Transfer\"},{\"type\":\"event\",\"inputs\":[{\"name\":\"_buyer\",\"type\":\"address\",\"indexed\":true},{\"name\":\"_amount\",\"type\":\"uint256\",\"indexed\":false},{\"name\":\"_value\",\"type\":\"uint256\",\"indexed\":false}],\"name\":\"Buy\"},{\"type\":\"event\",\"inputs\":[{\"name\":\"_buyer\",\"type\":\"address\",\"indexed\":true},{\"name\":\"_amount\",\"type\":\"uint256\",\"indexed\":false},{\"name\":\"_value\",\"type\":\"uint256\",\"indexed\":false}],\"name\":\"Sell\"},{\"type\":\"event\",\"inputs\":[{\"name\":\"_owner\",\"type\":\"address\",\"indexed\":true},{\"name\":\"_spender\",\"type\":\"address\",\"indexed\":true},{\"name\":\"_value\",\"type\":\"uint256\",\"indexed\":false}],\"name\":\"Approval\"},{\"type\":\"function\",\"name\":\"totalSupply\",\"inputs\": [],\"outputs\": [{\"name\": \"\", \"type\": \"uint256\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"balanceOf\",\"inputs\": [{\"name\": \"a\", \"type\": \"address\"}],\"outputs\": [{\"name\": \"\", \"type\": \"uint256\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"transfer\",\"inputs\": [{\"name\": \"_to\", \"type\": \"address\"},{\"name\": \"_amount\", \"type\": \"uint256\"}],\"outputs\": [{\"name\": \"\", \"type\": \"bool\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"approve\",\"inputs\": [{\"name\": \"_spender\", \"type\": \"address\"},{\"name\": \"_amount\", \"type\": \"uint256\"}],\"outputs\": [{\"name\": \"\", \"type\": \"bool\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"allowance\",\"inputs\": [{\"name\": \"_owner\", \"type\": \"address\"},{\"name\": \"_spender\", \"type\": \"address\"}],\"outputs\": [{\"name\": \"\", \"type\": \"uint256\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"transferFrom\",\"inputs\": [{\"name\": \"_from\", \"type\": \"address\"},{\"name\": \"_to\", \"type\": \"address\"},{\"name\": \"_amount\", \"type\": \"uint256\"}],\"outputs\": [{\"name\": \"\", \"type\": \"bool\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"buy\",\"inputs\": [{\"name\": \"_amount\", \"type\": \"uint256\"}],\"outputs\": [{\"name\": \"\", \"type\": \"bool\"}],\"payable\": true},{\"type\":\"function\",\"name\":\"sell\",\"inputs\": [{\"name\": \"_amount\", \"type\": \"uint256\"},{\"name\": \"_value\", \"type\": \"uint256\"}],\"outputs\": [{\"name\": \"\", \"type\": \"bool\"}],\"payable\": true}]\n```\n\n### Preparing the initial arguments\n\nWhen you deploy the code, the contract first becomes the `PreToken` contract.\n```\ncontract PreToken\n(uint256 totalSupply\n,address => uint256 balances\n,address => address => uint256 allowances\n)\n{\n    <snip>\n}\n```\n\nThe `PreToken` contract has three arguments `totalSupply`, `balances`, and `allowances`.  However, when you deploy the code, you can only specify `totalSupply` because the other arguments are mappings (TODO: document mappings and add a link here).\n\nLet's say we want the `totalSupply` to be `2^30`.  The argument needs to be in hex (without `0x`) and 64 characters (representing 32 bytes = 1 word in Ethereum).\n\n```\nvar totalSupply = \"0000000000000000000000000000000000000000000000000000000040000000\"\n```\n\nYou can check the length of `totalSupply` like this:\n```\n> totalSupply.length\n64\n```\nIf you have a different number, the contract will not be deployed.\n\nWhen we concatenate the code and the argument, we get the initialization data.\n```\nvar initdata = code + totalSupply\n```\n\n### Unlocking the Account\n\nIn order to deploy code, you need an unlocked account with positive balance.\n\n```\n> personal.unlockAccount(eth.accounts[0])\n```\n\n### Deploying the contract\n\n```\n> var tx = eth.sendTransaction({from: eth.accounts[0], data: initdata, gas: 4000000})\n```\n\nFor the beginning, while the transaction is not included in the blockchain yet, you see\n```\n> eth.getTransactionReceipt(tx)\nnull\n```\n\nAfter a while, you will see something like\n```\n> eth.getTransactionReceipt(tx)\n{\n  blockHash: \"0x00b34e48533b402b212b8278a06cd8455779af02eb213ca125e2cb0a67176d0c\",\n  blockNumber: 1417246,\n  contractAddress: \"0x624b4eab5c2dadc2e6db2e3517b0623d3bb15a68\",\n  cumulativeGasUsed: 3486372,\n  from: \"0xe64ae430b97ff403a194e214175c4144a82969f4\",\n  gasUsed: 3486372,\n  logs: [],\n  logsBloom: \"0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\",\n  root: \"0xfeeace094af32de1843304a2e50942a20e86275e97566b42da82aa5cc0d56f91\",\n  to: null,\n  transactionHash: \"0x3a8bb995cfd33af80d3a65d29f5c6906bb6759cde65824988fea3bb5794caaf4\",\n  transactionIndex: 0\n}\n```\n\nNow the Ethereum contract has been deployed on the Ropsten network!\n\n## Interacting with the Ethereum contract\n\nThe Ethereum contract is deployed at a certain address.\n```\nvar contractAddress = eth.getTransactionReceipt(tx).contractAddress\n```\n\nYou can get an object representing the Ethereum contract.\n```\nvar contract = eth.contract(abi).at(contractAddress)\n```\n\nNow remember that the contract is currently a `PreToken`:\n\n```\ncontract PreToken\n(uint256 totalSupply\n,address => uint256 balances\n,address => address => uint256 allowances\n)\n{\n    default\n    {\n        balances[this] = totalSupply;\n        return then become Token(totalSupply, balances, allowances);\n    }\n}\n```\n\nAs the source code reads, `PreToken` `become`s a `Token` contract when it is called with enough gas.\n\nNow let's just try to do that.\n\n```\n> eth.sendTransaction({from: eth.accounts[0], to: contractAddress, gas:3000000})\n```\n\nYou might need to unlock the account.\n\nAfter that, the contract becomes a `Token` contract.\n\n```\ncontract Token\n(uint256 totalSupply\n,address => uint256 balances\n,address => address => uint256 allowances\n)\n{\n    case(uint256 totalSupply())\n    {\n        <snip>\n    }\n    case(uint256 balanceOf(address a))\n    {\n        <snip>\n    }\n\n    case(bool transfer(address _to, uint256 _amount))\n    {\n        <snip>\n    }\n\n    case(bool approve(address _spender, uint256 _amount))\n    {\n        <snip>\n    }\n    case(uint256 allowance(address _owner, address _spender))\n    {\n        <snip>\n    }\n    case(bool transferFrom(address _from, address _to, uint256 _amount))\n    {\n        <snip>\n    }\n\n    case(bool buy(uint256 _amount))\n    {\n        <snip>\n    }\n    case (bool sell(uint256 _amount, uint256 _value))\n    {\n        <snip>\n    }\n}\n```\n\nYou don't have a balance in this ERC20 contract yet, so you can only `buy` the ERC20 token you have just created.\n\nSay you want to buy 100 tokens with 500 wei.\n\n```\n> contract.buy(100, {from: eth.accounts[0], value: 500})\n```\n\nAfter a while, you will see the balance\n```\n> contract.balanceOf.call(eth.accounts[0])\n100\n```\n\nNow you can use the other methods as well.  Try `transfer()` perhaps.\n"
  },
  {
    "path": "myocamlbuild.ml",
    "content": "(* OASIS_START *)\n(* DO NOT EDIT (digest: 9311c1947cc1275785273cf40407014e) *)\nmodule OASISGettext = struct\n(* # 22 \"src/oasis/OASISGettext.ml\" *)\n\n\n  let ns_ str = str\n  let s_ str = str\n  let f_ (str: ('a, 'b, 'c, 'd) format4) = str\n\n\n  let fn_ fmt1 fmt2 n =\n    if n = 1 then\n      fmt1^^\"\"\n    else\n      fmt2^^\"\"\n\n\n  let init = []\nend\n\nmodule OASISString = struct\n(* # 22 \"src/oasis/OASISString.ml\" *)\n\n\n  (** Various string utilities.\n\n      Mostly inspired by extlib and batteries ExtString and BatString libraries.\n\n      @author Sylvain Le Gall\n  *)\n\n\n  let nsplitf str f =\n    if str = \"\" then\n      []\n    else\n      let buf = Buffer.create 13 in\n      let lst = ref [] in\n      let push () =\n        lst := Buffer.contents buf :: !lst;\n        Buffer.clear buf\n      in\n      let str_len = String.length str in\n      for i = 0 to str_len - 1 do\n        if f str.[i] then\n          push ()\n        else\n          Buffer.add_char buf str.[i]\n      done;\n      push ();\n      List.rev !lst\n\n\n  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the\n      separator.\n  *)\n  let nsplit str c =\n    nsplitf str ((=) c)\n\n\n  let find ~what ?(offset=0) str =\n    let what_idx = ref 0 in\n    let str_idx = ref offset in\n    while !str_idx < String.length str &&\n          !what_idx < String.length what do\n      if str.[!str_idx] = what.[!what_idx] then\n        incr what_idx\n      else\n        what_idx := 0;\n      incr str_idx\n    done;\n    if !what_idx <> String.length what then\n      raise Not_found\n    else\n      !str_idx - !what_idx\n\n\n  let sub_start str len =\n    let str_len = String.length str in\n    if len >= str_len then\n      \"\"\n    else\n      String.sub str len (str_len - len)\n\n\n  let sub_end ?(offset=0) str len =\n    let str_len = String.length str in\n    if len >= str_len then\n      \"\"\n    else\n      String.sub str 0 (str_len - len)\n\n\n  let starts_with ~what ?(offset=0) str =\n    let what_idx = ref 0 in\n    let str_idx = ref offset in\n    let ok = ref true in\n    while !ok &&\n          !str_idx < String.length str &&\n          !what_idx < String.length what do\n      if str.[!str_idx] = what.[!what_idx] then\n        incr what_idx\n      else\n        ok := false;\n      incr str_idx\n    done;\n    !what_idx = String.length what\n\n\n  let strip_starts_with ~what str =\n    if starts_with ~what str then\n      sub_start str (String.length what)\n    else\n      raise Not_found\n\n\n  let ends_with ~what ?(offset=0) str =\n    let what_idx = ref ((String.length what) - 1) in\n    let str_idx = ref ((String.length str) - 1) in\n    let ok = ref true in\n    while !ok &&\n          offset <= !str_idx &&\n          0 <= !what_idx do\n      if str.[!str_idx] = what.[!what_idx] then\n        decr what_idx\n      else\n        ok := false;\n      decr str_idx\n    done;\n    !what_idx = -1\n\n\n  let strip_ends_with ~what str =\n    if ends_with ~what str then\n      sub_end str (String.length what)\n    else\n      raise Not_found\n\n\n  let replace_chars f s =\n    let buf = Buffer.create (String.length s) in\n    String.iter (fun c -> Buffer.add_char buf (f c)) s;\n    Buffer.contents buf\n\n  let lowercase_ascii =\n    replace_chars\n      (fun c ->\n         if (c >= 'A' && c <= 'Z') then\n           Char.chr (Char.code c + 32)\n         else\n           c)\n\n  let uncapitalize_ascii s =\n    if s <> \"\" then\n      (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))\n    else\n      s\n\n  let uppercase_ascii =\n    replace_chars\n      (fun c ->\n         if (c >= 'a' && c <= 'z') then\n           Char.chr (Char.code c - 32)\n         else\n           c)\n\n  let capitalize_ascii s =\n    if s <> \"\" then\n      (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))\n    else\n      s\n\nend\n\nmodule OASISUtils = struct\n(* # 22 \"src/oasis/OASISUtils.ml\" *)\n\n\n  open OASISGettext\n\n\n  module MapExt =\n  struct\n    module type S =\n    sig\n      include Map.S\n      val add_list: 'a t -> (key * 'a) list -> 'a t\n      val of_list: (key * 'a) list -> 'a t\n      val to_list: 'a t -> (key * 'a) list\n    end\n\n    module Make (Ord: Map.OrderedType) =\n    struct\n      include Map.Make(Ord)\n\n      let rec add_list t =\n        function\n          | (k, v) :: tl -> add_list (add k v t) tl\n          | [] -> t\n\n      let of_list lst = add_list empty lst\n\n      let to_list t = fold (fun k v acc -> (k, v) :: acc) t []\n    end\n  end\n\n\n  module MapString = MapExt.Make(String)\n\n\n  module SetExt  =\n  struct\n    module type S =\n    sig\n      include Set.S\n      val add_list: t -> elt list -> t\n      val of_list: elt list -> t\n      val to_list: t -> elt list\n    end\n\n    module Make (Ord: Set.OrderedType) =\n    struct\n      include Set.Make(Ord)\n\n      let rec add_list t =\n        function\n          | e :: tl -> add_list (add e t) tl\n          | [] -> t\n\n      let of_list lst = add_list empty lst\n\n      let to_list = elements\n    end\n  end\n\n\n  module SetString = SetExt.Make(String)\n\n\n  let compare_csl s1 s2 =\n    String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)\n\n\n  module HashStringCsl =\n    Hashtbl.Make\n      (struct\n         type t = string\n         let equal s1 s2 = (compare_csl s1 s2) = 0\n         let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)\n       end)\n\n  module SetStringCsl =\n    SetExt.Make\n      (struct\n         type t = string\n         let compare = compare_csl\n       end)\n\n\n  let varname_of_string ?(hyphen='_') s =\n    if String.length s = 0 then\n      begin\n        invalid_arg \"varname_of_string\"\n      end\n    else\n      begin\n        let buf =\n          OASISString.replace_chars\n            (fun c ->\n               if ('a' <= c && c <= 'z')\n                 ||\n                  ('A' <= c && c <= 'Z')\n                 ||\n                  ('0' <= c && c <= '9') then\n                 c\n               else\n                 hyphen)\n            s;\n        in\n        let buf =\n          (* Start with a _ if digit *)\n          if '0' <= s.[0] && s.[0] <= '9' then\n            \"_\"^buf\n          else\n            buf\n        in\n          OASISString.lowercase_ascii buf\n      end\n\n\n  let varname_concat ?(hyphen='_') p s =\n    let what = String.make 1 hyphen in\n    let p =\n      try\n        OASISString.strip_ends_with ~what p\n      with Not_found ->\n        p\n    in\n    let s =\n      try\n        OASISString.strip_starts_with ~what s\n      with Not_found ->\n        s\n    in\n      p^what^s\n\n\n  let is_varname str =\n    str = varname_of_string str\n\n\n  let failwithf fmt = Printf.ksprintf failwith fmt\n\n\n  let rec file_location ?pos1 ?pos2 ?lexbuf () =\n      match pos1, pos2, lexbuf with\n      | Some p, None, _ | None, Some p, _ ->\n        file_location ~pos1:p ~pos2:p ?lexbuf ()\n      | Some p1, Some p2, _ ->\n        let open Lexing in\n        let fn, lineno = p1.pos_fname, p1.pos_lnum in\n        let c1 = p1.pos_cnum - p1.pos_bol in\n        let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in\n        Printf.sprintf (f_ \"file %S, line %d, characters %d-%d\")  fn lineno c1 c2\n      | _, _, Some lexbuf ->\n        file_location\n          ~pos1:(Lexing.lexeme_start_p lexbuf)\n          ~pos2:(Lexing.lexeme_end_p lexbuf)\n          ()\n      | None, None, None ->\n        s_ \"<position undefined>\"\n\n\n  let failwithpf ?pos1 ?pos2 ?lexbuf fmt =\n    let loc = file_location ?pos1 ?pos2 ?lexbuf () in\n    Printf.ksprintf (fun s -> failwith (Printf.sprintf \"%s: %s\" loc s)) fmt\n\n\nend\n\nmodule OASISExpr = struct\n(* # 22 \"src/oasis/OASISExpr.ml\" *)\n\n\n  open OASISGettext\n  open OASISUtils\n\n\n  type test = string\n  type flag = string\n\n\n  type t =\n    | EBool of bool\n    | ENot of t\n    | EAnd of t * t\n    | EOr of t * t\n    | EFlag of flag\n    | ETest of test * string\n\n\n  type 'a choices = (t * 'a) list\n\n\n  let eval var_get t =\n    let rec eval' =\n      function\n        | EBool b ->\n            b\n\n        | ENot e ->\n            not (eval' e)\n\n        | EAnd (e1, e2) ->\n            (eval' e1) && (eval' e2)\n\n        | EOr (e1, e2) ->\n            (eval' e1) || (eval' e2)\n\n        | EFlag nm ->\n            let v =\n              var_get nm\n            in\n              assert(v = \"true\" || v = \"false\");\n              (v = \"true\")\n\n        | ETest (nm, vl) ->\n            let v =\n              var_get nm\n            in\n              (v = vl)\n    in\n      eval' t\n\n\n  let choose ?printer ?name var_get lst =\n    let rec choose_aux =\n      function\n        | (cond, vl) :: tl ->\n            if eval var_get cond then\n              vl\n            else\n              choose_aux tl\n        | [] ->\n            let str_lst =\n              if lst = [] then\n                s_ \"<empty>\"\n              else\n                String.concat\n                  (s_ \", \")\n                  (List.map\n                     (fun (cond, vl) ->\n                        match printer with\n                          | Some p -> p vl\n                          | None -> s_ \"<no printer>\")\n                     lst)\n            in\n              match name with\n                | Some nm ->\n                    failwith\n                      (Printf.sprintf\n                         (f_ \"No result for the choice list '%s': %s\")\n                         nm str_lst)\n                | None ->\n                    failwith\n                      (Printf.sprintf\n                         (f_ \"No result for a choice list: %s\")\n                         str_lst)\n    in\n      choose_aux (List.rev lst)\n\n\nend\n\n\n# 437 \"myocamlbuild.ml\"\nmodule BaseEnvLight = struct\n(* # 22 \"src/base/BaseEnvLight.ml\" *)\n\n\n  module MapString = Map.Make(String)\n\n\n  type t = string MapString.t\n\n\n  let default_filename = Filename.concat (Sys.getcwd ()) \"setup.data\"\n\n\n  let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =\n    let line = ref 1 in\n    let lexer st =\n      let st_line =\n        Stream.from\n          (fun _ ->\n             try\n               match Stream.next st with\n               | '\\n' -> incr line; Some '\\n'\n               | c -> Some c\n             with Stream.Failure -> None)\n      in\n      Genlex.make_lexer [\"=\"] st_line\n    in\n    let rec read_file lxr mp =\n      match Stream.npeek 3 lxr with\n      | [Genlex.Ident nm; Genlex.Kwd \"=\"; Genlex.String value] ->\n        Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;\n        read_file lxr (MapString.add nm value mp)\n      | [] -> mp\n      | _ ->\n        failwith\n          (Printf.sprintf \"Malformed data file '%s' line %d\" filename !line)\n    in\n    match stream with\n    | Some st -> read_file (lexer st) MapString.empty\n    | None ->\n      if Sys.file_exists filename then begin\n        let chn = open_in_bin filename in\n        let st = Stream.of_channel chn in\n        try\n          let mp = read_file (lexer st) MapString.empty in\n          close_in chn; mp\n        with e ->\n          close_in chn; raise e\n      end else if allow_empty then begin\n        MapString.empty\n      end else begin\n        failwith\n          (Printf.sprintf\n             \"Unable to load environment, the file '%s' doesn't exist.\"\n             filename)\n      end\n\n  let rec var_expand str env =\n    let buff = Buffer.create ((String.length str) * 2) in\n    Buffer.add_substitute\n      buff\n      (fun var ->\n         try\n           var_expand (MapString.find var env) env\n         with Not_found ->\n           failwith\n             (Printf.sprintf\n                \"No variable %s defined when trying to expand %S.\"\n                var\n                str))\n      str;\n    Buffer.contents buff\n\n\n  let var_get name env = var_expand (MapString.find name env) env\n  let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst\nend\n\n\n# 517 \"myocamlbuild.ml\"\nmodule MyOCamlbuildFindlib = struct\n(* # 22 \"src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml\" *)\n\n\n  (** OCamlbuild extension, copied from\n    * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html\n    * by N. Pouillard and others\n    *\n    * Updated on 2016-06-02\n    *\n    * Modified by Sylvain Le Gall\n  *)\n  open Ocamlbuild_plugin\n\n\n  type conf = {no_automatic_syntax: bool}\n\n\n  let run_and_read = Ocamlbuild_pack.My_unix.run_and_read\n\n\n  let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings\n\n\n  let exec_from_conf exec =\n    let exec =\n      let env = BaseEnvLight.load ~allow_empty:true () in\n      try\n        BaseEnvLight.var_get exec env\n      with Not_found ->\n        Printf.eprintf \"W: Cannot get variable %s\\n\" exec;\n        exec\n    in\n    let fix_win32 str =\n      if Sys.os_type = \"Win32\" then begin\n        let buff = Buffer.create (String.length str) in\n        (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\\\'.\n        *)\n        String.iter\n          (fun c -> Buffer.add_char buff (if c = '\\\\' then '/' else c))\n          str;\n        Buffer.contents buff\n      end else begin\n        str\n      end\n    in\n    fix_win32 exec\n\n\n  let split s ch =\n    let buf = Buffer.create 13 in\n    let x = ref [] in\n    let flush () =\n      x := (Buffer.contents buf) :: !x;\n      Buffer.clear buf\n    in\n    String.iter\n      (fun c ->\n         if c = ch then\n           flush ()\n         else\n           Buffer.add_char buf c)\n      s;\n    flush ();\n    List.rev !x\n\n\n  let split_nl s = split s '\\n'\n\n\n  let before_space s =\n    try\n      String.before s (String.index s ' ')\n    with Not_found -> s\n\n  (* ocamlfind command *)\n  let ocamlfind x = S[Sh (exec_from_conf \"ocamlfind\"); x]\n\n  (* This lists all supported packages. *)\n  let find_packages () =\n    List.map before_space (split_nl & run_and_read (exec_from_conf \"ocamlfind\" ^ \" list\"))\n\n\n  (* Mock to list available syntaxes. *)\n  let find_syntaxes () = [\"camlp4o\"; \"camlp4r\"]\n\n\n  let well_known_syntax = [\n    \"camlp4.quotations.o\";\n    \"camlp4.quotations.r\";\n    \"camlp4.exceptiontracer\";\n    \"camlp4.extend\";\n    \"camlp4.foldgenerator\";\n    \"camlp4.listcomprehension\";\n    \"camlp4.locationstripper\";\n    \"camlp4.macro\";\n    \"camlp4.mapgenerator\";\n    \"camlp4.metagenerator\";\n    \"camlp4.profiler\";\n    \"camlp4.tracer\"\n  ]\n\n\n  let dispatch conf =\n    function\n      | After_options ->\n        (* By using Before_options one let command line options have an higher\n         * priority on the contrary using After_options will guarantee to have\n         * the higher priority override default commands by ocamlfind ones *)\n        Options.ocamlc     := ocamlfind & A\"ocamlc\";\n        Options.ocamlopt   := ocamlfind & A\"ocamlopt\";\n        Options.ocamldep   := ocamlfind & A\"ocamldep\";\n        Options.ocamldoc   := ocamlfind & A\"ocamldoc\";\n        Options.ocamlmktop := ocamlfind & A\"ocamlmktop\";\n        Options.ocamlmklib := ocamlfind & A\"ocamlmklib\"\n\n      | After_rules ->\n\n        (* Avoid warnings for unused tag *)\n        flag [\"tests\"] N;\n\n        (* When one link an OCaml library/binary/package, one should use\n         * -linkpkg *)\n        flag [\"ocaml\"; \"link\"; \"program\"] & A\"-linkpkg\";\n\n        (* For each ocamlfind package one inject the -package option when\n         * compiling, computing dependencies, generating documentation and\n         * linking. *)\n        List.iter\n          begin fun pkg ->\n            let base_args = [A\"-package\"; A pkg] in\n            (* TODO: consider how to really choose camlp4o or camlp4r. *)\n            let syn_args = [A\"-syntax\"; A \"camlp4o\"] in\n            let (args, pargs) =\n              (* Heuristic to identify syntax extensions: whether they end in\n                 \".syntax\"; some might not.\n              *)\n              if not (conf.no_automatic_syntax) &&\n                 (Filename.check_suffix pkg \"syntax\" ||\n                  List.mem pkg well_known_syntax) then\n                (syn_args @ base_args, syn_args)\n              else\n                (base_args, [])\n            in\n            flag [\"ocaml\"; \"compile\";  \"pkg_\"^pkg] & S args;\n            flag [\"ocaml\"; \"ocamldep\"; \"pkg_\"^pkg] & S args;\n            flag [\"ocaml\"; \"doc\";      \"pkg_\"^pkg] & S args;\n            flag [\"ocaml\"; \"link\";     \"pkg_\"^pkg] & S base_args;\n            flag [\"ocaml\"; \"infer_interface\"; \"pkg_\"^pkg] & S args;\n\n            (* TODO: Check if this is allowed for OCaml < 3.12.1 *)\n            flag [\"ocaml\"; \"compile\";  \"package(\"^pkg^\")\"] & S pargs;\n            flag [\"ocaml\"; \"ocamldep\"; \"package(\"^pkg^\")\"] & S pargs;\n            flag [\"ocaml\"; \"doc\";      \"package(\"^pkg^\")\"] & S pargs;\n            flag [\"ocaml\"; \"infer_interface\"; \"package(\"^pkg^\")\"] & S pargs;\n          end\n          (find_packages ());\n\n        (* Like -package but for extensions syntax. Morover -syntax is useless\n         * when linking. *)\n        List.iter begin fun syntax ->\n          flag [\"ocaml\"; \"compile\";  \"syntax_\"^syntax] & S[A\"-syntax\"; A syntax];\n          flag [\"ocaml\"; \"ocamldep\"; \"syntax_\"^syntax] & S[A\"-syntax\"; A syntax];\n          flag [\"ocaml\"; \"doc\";      \"syntax_\"^syntax] & S[A\"-syntax\"; A syntax];\n          flag [\"ocaml\"; \"infer_interface\"; \"syntax_\"^syntax] &\n          S[A\"-syntax\"; A syntax];\n        end (find_syntaxes ());\n\n        (* The default \"thread\" tag is not compatible with ocamlfind.\n         * Indeed, the default rules add the \"threads.cma\" or \"threads.cmxa\"\n         * options when using this tag. When using the \"-linkpkg\" option with\n         * ocamlfind, this module will then be added twice on the command line.\n         *\n         * To solve this, one approach is to add the \"-thread\" option when using\n         * the \"threads\" package using the previous plugin.\n        *)\n        flag [\"ocaml\"; \"pkg_threads\"; \"compile\"] (S[A \"-thread\"]);\n        flag [\"ocaml\"; \"pkg_threads\"; \"doc\"] (S[A \"-I\"; A \"+threads\"]);\n        flag [\"ocaml\"; \"pkg_threads\"; \"link\"] (S[A \"-thread\"]);\n        flag [\"ocaml\"; \"pkg_threads\"; \"infer_interface\"] (S[A \"-thread\"]);\n        flag [\"c\"; \"pkg_threads\"; \"compile\"] (S[A \"-thread\"]);\n        flag [\"ocaml\"; \"package(threads)\"; \"compile\"] (S[A \"-thread\"]);\n        flag [\"ocaml\"; \"package(threads)\"; \"doc\"] (S[A \"-I\"; A \"+threads\"]);\n        flag [\"ocaml\"; \"package(threads)\"; \"link\"] (S[A \"-thread\"]);\n        flag [\"ocaml\"; \"package(threads)\"; \"infer_interface\"] (S[A \"-thread\"]);\n        flag [\"c\"; \"package(threads)\"; \"compile\"] (S[A \"-thread\"]);\n\n      | _ ->\n        ()\nend\n\nmodule MyOCamlbuildBase = struct\n(* # 22 \"src/plugins/ocamlbuild/MyOCamlbuildBase.ml\" *)\n\n\n  (** Base functions for writing myocamlbuild.ml\n      @author Sylvain Le Gall\n    *)\n\n\n  open Ocamlbuild_plugin\n  module OC = Ocamlbuild_pack.Ocaml_compiler\n\n\n  type dir = string\n  type file = string\n  type name = string\n  type tag = string\n\n\n  type t =\n      {\n        lib_ocaml: (name * dir list * string list) list;\n        lib_c:     (name * dir * file list) list;\n        flags:     (tag list * (spec OASISExpr.choices)) list;\n        (* Replace the 'dir: include' from _tags by a precise interdepends in\n         * directory.\n         *)\n        includes:  (dir * dir list) list;\n      }\n\n\n(* # 110 \"src/plugins/ocamlbuild/MyOCamlbuildBase.ml\" *)\n\n\n  let env_filename = Pathname.basename BaseEnvLight.default_filename\n\n\n  let dispatch_combine lst =\n    fun e ->\n      List.iter\n        (fun dispatch -> dispatch e)\n        lst\n\n\n  let tag_libstubs nm =\n    \"use_lib\"^nm^\"_stubs\"\n\n\n  let nm_libstubs nm =\n    nm^\"_stubs\"\n\n\n  let dispatch t e =\n    let env = BaseEnvLight.load ~allow_empty:true () in\n      match e with\n        | Before_options ->\n            let no_trailing_dot s =\n              if String.length s >= 1 && s.[0] = '.' then\n                String.sub s 1 ((String.length s) - 1)\n              else\n                s\n            in\n              List.iter\n                (fun (opt, var) ->\n                   try\n                     opt := no_trailing_dot (BaseEnvLight.var_get var env)\n                   with Not_found ->\n                     Printf.eprintf \"W: Cannot get variable %s\\n\" var)\n                [\n                  Options.ext_obj, \"ext_obj\";\n                  Options.ext_lib, \"ext_lib\";\n                  Options.ext_dll, \"ext_dll\";\n                ]\n\n        | After_rules ->\n            (* Declare OCaml libraries *)\n            List.iter\n              (function\n                 | nm, [], intf_modules ->\n                     ocaml_lib nm;\n                     let cmis =\n                       List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ \".cmi\")\n                                intf_modules in\n                     dep [\"ocaml\"; \"link\"; \"library\"; \"file:\"^nm^\".cma\"] cmis\n                 | nm, dir :: tl, intf_modules ->\n                     ocaml_lib ~dir:dir (dir^\"/\"^nm);\n                     List.iter\n                       (fun dir ->\n                          List.iter\n                            (fun str ->\n                               flag [\"ocaml\"; \"use_\"^nm; str] (S[A\"-I\"; P dir]))\n                            [\"compile\"; \"infer_interface\"; \"doc\"])\n                       tl;\n                     let cmis =\n                       List.map (fun m -> dir^\"/\"^(OASISString.uncapitalize_ascii m)^\".cmi\")\n                                intf_modules in\n                     dep [\"ocaml\"; \"link\"; \"library\"; \"file:\"^dir^\"/\"^nm^\".cma\"]\n                         cmis)\n              t.lib_ocaml;\n\n            (* Declare directories dependencies, replace \"include\" in _tags. *)\n            List.iter\n              (fun (dir, include_dirs) ->\n                 Pathname.define_context dir include_dirs)\n              t.includes;\n\n            (* Declare C libraries *)\n            List.iter\n              (fun (lib, dir, headers) ->\n                   (* Handle C part of library *)\n                   flag [\"link\"; \"library\"; \"ocaml\"; \"byte\"; tag_libstubs lib]\n                     (S[A\"-dllib\"; A(\"-l\"^(nm_libstubs lib)); A\"-cclib\";\n                        A(\"-l\"^(nm_libstubs lib))]);\n\n                   flag [\"link\"; \"library\"; \"ocaml\"; \"native\"; tag_libstubs lib]\n                     (S[A\"-cclib\"; A(\"-l\"^(nm_libstubs lib))]);\n\n                   if bool_of_string (BaseEnvLight.var_get \"native_dynlink\" env) then\n                     flag [\"link\"; \"program\"; \"ocaml\"; \"byte\"; tag_libstubs lib]\n                         (S[A\"-dllib\"; A(\"dll\"^(nm_libstubs lib))]);\n\n                   (* When ocaml link something that use the C library, then one\n                      need that file to be up to date.\n                      This holds both for programs and for libraries.\n                    *)\n                   dep [\"link\"; \"ocaml\"; tag_libstubs lib]\n                     [dir/\"lib\"^(nm_libstubs lib)^\".\"^(!Options.ext_lib)];\n\n                   dep  [\"compile\"; \"ocaml\"; tag_libstubs lib]\n                     [dir/\"lib\"^(nm_libstubs lib)^\".\"^(!Options.ext_lib)];\n\n                   (* TODO: be more specific about what depends on headers *)\n                   (* Depends on .h files *)\n                   dep [\"compile\"; \"c\"]\n                     headers;\n\n                   (* Setup search path for lib *)\n                   flag [\"link\"; \"ocaml\"; \"use_\"^lib]\n                     (S[A\"-I\"; P(dir)]);\n              )\n              t.lib_c;\n\n              (* Add flags *)\n              List.iter\n              (fun (tags, cond_specs) ->\n                 let spec = BaseEnvLight.var_choose cond_specs env in\n                 let rec eval_specs =\n                   function\n                     | S lst -> S (List.map eval_specs lst)\n                     | A str -> A (BaseEnvLight.var_expand str env)\n                     | spec -> spec\n                 in\n                   flag tags & (eval_specs spec))\n              t.flags\n        | _ ->\n            ()\n\n\n  let dispatch_default conf t =\n    dispatch_combine\n      [\n        dispatch t;\n        MyOCamlbuildFindlib.dispatch conf;\n      ]\n\n\nend\n\n\n# 878 \"myocamlbuild.ml\"\nopen Ocamlbuild_plugin;;\nlet package_default =\n  {\n     MyOCamlbuildBase.lib_ocaml =\n       [\n          (\"cross-platform\", [\"src/cross-platform-for-ocamlbuild\"], []);\n          (\"basics\", [\"src/basics\"], []);\n          (\"ast\", [\"src/ast\"], []);\n          (\"parse\", [\"src/parse\"], []);\n          (\"codegen\", [\"src/codegen\"], [])\n       ];\n     lib_c = [];\n     flags = [];\n     includes =\n       [\n          (\"src/parse\", [\"src/ast\"]);\n          (\"src/exec\", [\"src/codegen\"; \"src/parse\"]);\n          (\"src/codegen\", [\"src/ast\"; \"src/basics\"; \"src/parse\"]);\n          (\"src/basics\", [\"src/cross-platform-for-ocamlbuild\"]);\n          (\"src/ast\", [\"src/basics\"])\n       ]\n  }\n  ;;\n\nlet conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}\n\nlet dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;\n\n# 908 \"myocamlbuild.ml\"\n(* OASIS_STOP *)\nOcamlbuild_plugin.dispatch dispatch_default;;\n"
  },
  {
    "path": "opam/descr",
    "content": "A compiler targeting Ethereum Virtual Machine\n\nBamboo compiles a simple language to Ethereum Virtual Machine. The\nlanguage is designed to keep programmers away from common mistakes. It\nfeatures: state transition as recursion with potentially changing\narguments, mandatory reentrance continuation when calling out, no\nloops, no assignments except to mappings and partial compliance with\ncommon Ethereum ABI.\n"
  },
  {
    "path": "opam/opam",
    "content": "opam-version: \"1.2\"\nmaintainer: \"Yoichi Hirai <i@yoichihirai.com>\"\nauthors: \"Yoichi Hirai <i@yoichihirai.com>\"\nname: \"bamboo\"\nversion: \"0.0.03\"\nhomepage: \"https://github.com/pirapira/bamboo\"\nbug-reports: \"https://github.com/pirapira/bamboo/issues\"\nlicense: \"Apache-2.0\"\ndev-repo: \"https://github.com/pirapira/bamboo.git\"\nbuild: [\n  [\n    \"rm\"\n    \"-f\"\n    \"src/parse/parser.ml\"\n    \"src/parse/parser.mli\"\n    \"src/parse/lexer.ml\"\n  ]\n  [\"ocaml\" \"setup.ml\" \"-configure\" \"--prefix\" prefix]\n  [\"ocaml\" \"setup.ml\" \"-build\"]\n]\ninstall: [\"ocaml\" \"setup.ml\" \"-install\"]\nbuild-test: [\n  [\"ocaml\" \"setup.ml\" \"-configure\" \"--enable-tests\"]\n  [\"ocaml\" \"setup.ml\" \"-build\"]\n  [\"ocaml\" \"setup.ml\" \"-test\"]\n]\nremove: [\"ocamlfind\" \"remove\" \"bamboo\"]\ndepends: [\n  \"batteries\" {build}\n  \"cryptokit\" {build & >= \"1.12\"}\n  \"hex\" {build & >= \"0.1.0\" & <= \"1.0.0\"}\n  \"menhir\" {build & >= \"20120123\" & <= \"20151005\"}\n  \"ocamlbuild\" {build & (>= \"0.9.3\" | = \"0\")}\n  \"ocamlfind\" {build}\n  \"rope\" {build}\n]\n"
  },
  {
    "path": "package.json",
    "content": "{\n  \"name\": \"bamboo\",\n  \"version\": \"0.0.02\",\n  \"description\": \"A compiler targeting Ethereum Virtual Machine\",\n  \"keywords\": [\n    \"ethereum\",\n    \"smart-contracts\",\n    \"blockchain\",\n    \"virtual machine\",\n    \"compiler\"\n  ],\n  \"repository\": {\n    \"type\": \"git\",\n    \"url\": \"https://github.com/pirapira/bamboo\"\n  },\n  \"homepage\": \"https://github.com/pirapira/bamboo\",\n  \"author\": \"Yoichi Hirai <i@yoichihirai.com>\",\n  \"license\": \"Apache-2.0\",\n  \"devDependencies\": {\n    \"bs-platform\": \"bsansouci/bsb-native#2.1.1\"\n  },\n  \"scripts\": {\n    \"build\": \"bsb -make-world -backend native\",\n    \"build-js\": \"bsb -make-world -backend js\",\n    \"watch\": \"bsb -make-world -backend native -w\",\n    \"test\": \"npm run build && ./lib/bs/native/test.native\",\n    \"clean\": \"bsb -clean-world\"\n  },\n  \"dependencies\": {\n    \"bn.js\": \"^4.11.8\",\n    \"bs-bn.js\": \"0.0.2\",\n    \"keccak\": \"^1.4.0\"\n  }\n}\n"
  },
  {
    "path": "setup.ml",
    "content": "(* setup.ml generated for the first time by OASIS v0.4.10 *)\n\n(* OASIS_START *)\n(* DO NOT EDIT (digest: e49f9499c8ae75ca2ab01e5d5fc622dd) *)\n(*\n   Regenerated by OASIS v0.4.10\n   Visit http://oasis.forge.ocamlcore.org for more information and\n   documentation about functions used in this file.\n*)\nmodule OASISGettext = struct\n(* # 22 \"src/oasis/OASISGettext.ml\" *)\n\n\n  let ns_ str = str\n  let s_ str = str\n  let f_ (str: ('a, 'b, 'c, 'd) format4) = str\n\n\n  let fn_ fmt1 fmt2 n =\n    if n = 1 then\n      fmt1^^\"\"\n    else\n      fmt2^^\"\"\n\n\n  let init = []\nend\n\nmodule OASISString = struct\n(* # 22 \"src/oasis/OASISString.ml\" *)\n\n\n  (** Various string utilities.\n\n      Mostly inspired by extlib and batteries ExtString and BatString libraries.\n\n      @author Sylvain Le Gall\n  *)\n\n\n  let nsplitf str f =\n    if str = \"\" then\n      []\n    else\n      let buf = Buffer.create 13 in\n      let lst = ref [] in\n      let push () =\n        lst := Buffer.contents buf :: !lst;\n        Buffer.clear buf\n      in\n      let str_len = String.length str in\n      for i = 0 to str_len - 1 do\n        if f str.[i] then\n          push ()\n        else\n          Buffer.add_char buf str.[i]\n      done;\n      push ();\n      List.rev !lst\n\n\n  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the\n      separator.\n  *)\n  let nsplit str c =\n    nsplitf str ((=) c)\n\n\n  let find ~what ?(offset=0) str =\n    let what_idx = ref 0 in\n    let str_idx = ref offset in\n    while !str_idx < String.length str &&\n          !what_idx < String.length what do\n      if str.[!str_idx] = what.[!what_idx] then\n        incr what_idx\n      else\n        what_idx := 0;\n      incr str_idx\n    done;\n    if !what_idx <> String.length what then\n      raise Not_found\n    else\n      !str_idx - !what_idx\n\n\n  let sub_start str len =\n    let str_len = String.length str in\n    if len >= str_len then\n      \"\"\n    else\n      String.sub str len (str_len - len)\n\n\n  let sub_end ?(offset=0) str len =\n    let str_len = String.length str in\n    if len >= str_len then\n      \"\"\n    else\n      String.sub str 0 (str_len - len)\n\n\n  let starts_with ~what ?(offset=0) str =\n    let what_idx = ref 0 in\n    let str_idx = ref offset in\n    let ok = ref true in\n    while !ok &&\n          !str_idx < String.length str &&\n          !what_idx < String.length what do\n      if str.[!str_idx] = what.[!what_idx] then\n        incr what_idx\n      else\n        ok := false;\n      incr str_idx\n    done;\n    !what_idx = String.length what\n\n\n  let strip_starts_with ~what str =\n    if starts_with ~what str then\n      sub_start str (String.length what)\n    else\n      raise Not_found\n\n\n  let ends_with ~what ?(offset=0) str =\n    let what_idx = ref ((String.length what) - 1) in\n    let str_idx = ref ((String.length str) - 1) in\n    let ok = ref true in\n    while !ok &&\n          offset <= !str_idx &&\n          0 <= !what_idx do\n      if str.[!str_idx] = what.[!what_idx] then\n        decr what_idx\n      else\n        ok := false;\n      decr str_idx\n    done;\n    !what_idx = -1\n\n\n  let strip_ends_with ~what str =\n    if ends_with ~what str then\n      sub_end str (String.length what)\n    else\n      raise Not_found\n\n\n  let replace_chars f s =\n    let buf = Buffer.create (String.length s) in\n    String.iter (fun c -> Buffer.add_char buf (f c)) s;\n    Buffer.contents buf\n\n  let lowercase_ascii =\n    replace_chars\n      (fun c ->\n         if (c >= 'A' && c <= 'Z') then\n           Char.chr (Char.code c + 32)\n         else\n           c)\n\n  let uncapitalize_ascii s =\n    if s <> \"\" then\n      (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))\n    else\n      s\n\n  let uppercase_ascii =\n    replace_chars\n      (fun c ->\n         if (c >= 'a' && c <= 'z') then\n           Char.chr (Char.code c - 32)\n         else\n           c)\n\n  let capitalize_ascii s =\n    if s <> \"\" then\n      (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))\n    else\n      s\n\nend\n\nmodule OASISUtils = struct\n(* # 22 \"src/oasis/OASISUtils.ml\" *)\n\n\n  open OASISGettext\n\n\n  module MapExt =\n  struct\n    module type S =\n    sig\n      include Map.S\n      val add_list: 'a t -> (key * 'a) list -> 'a t\n      val of_list: (key * 'a) list -> 'a t\n      val to_list: 'a t -> (key * 'a) list\n    end\n\n    module Make (Ord: Map.OrderedType) =\n    struct\n      include Map.Make(Ord)\n\n      let rec add_list t =\n        function\n          | (k, v) :: tl -> add_list (add k v t) tl\n          | [] -> t\n\n      let of_list lst = add_list empty lst\n\n      let to_list t = fold (fun k v acc -> (k, v) :: acc) t []\n    end\n  end\n\n\n  module MapString = MapExt.Make(String)\n\n\n  module SetExt  =\n  struct\n    module type S =\n    sig\n      include Set.S\n      val add_list: t -> elt list -> t\n      val of_list: elt list -> t\n      val to_list: t -> elt list\n    end\n\n    module Make (Ord: Set.OrderedType) =\n    struct\n      include Set.Make(Ord)\n\n      let rec add_list t =\n        function\n          | e :: tl -> add_list (add e t) tl\n          | [] -> t\n\n      let of_list lst = add_list empty lst\n\n      let to_list = elements\n    end\n  end\n\n\n  module SetString = SetExt.Make(String)\n\n\n  let compare_csl s1 s2 =\n    String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)\n\n\n  module HashStringCsl =\n    Hashtbl.Make\n      (struct\n         type t = string\n         let equal s1 s2 = (compare_csl s1 s2) = 0\n         let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)\n       end)\n\n  module SetStringCsl =\n    SetExt.Make\n      (struct\n         type t = string\n         let compare = compare_csl\n       end)\n\n\n  let varname_of_string ?(hyphen='_') s =\n    if String.length s = 0 then\n      begin\n        invalid_arg \"varname_of_string\"\n      end\n    else\n      begin\n        let buf =\n          OASISString.replace_chars\n            (fun c ->\n               if ('a' <= c && c <= 'z')\n                 ||\n                  ('A' <= c && c <= 'Z')\n                 ||\n                  ('0' <= c && c <= '9') then\n                 c\n               else\n                 hyphen)\n            s;\n        in\n        let buf =\n          (* Start with a _ if digit *)\n          if '0' <= s.[0] && s.[0] <= '9' then\n            \"_\"^buf\n          else\n            buf\n        in\n          OASISString.lowercase_ascii buf\n      end\n\n\n  let varname_concat ?(hyphen='_') p s =\n    let what = String.make 1 hyphen in\n    let p =\n      try\n        OASISString.strip_ends_with ~what p\n      with Not_found ->\n        p\n    in\n    let s =\n      try\n        OASISString.strip_starts_with ~what s\n      with Not_found ->\n        s\n    in\n      p^what^s\n\n\n  let is_varname str =\n    str = varname_of_string str\n\n\n  let failwithf fmt = Printf.ksprintf failwith fmt\n\n\n  let rec file_location ?pos1 ?pos2 ?lexbuf () =\n      match pos1, pos2, lexbuf with\n      | Some p, None, _ | None, Some p, _ ->\n        file_location ~pos1:p ~pos2:p ?lexbuf ()\n      | Some p1, Some p2, _ ->\n        let open Lexing in\n        let fn, lineno = p1.pos_fname, p1.pos_lnum in\n        let c1 = p1.pos_cnum - p1.pos_bol in\n        let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in\n        Printf.sprintf (f_ \"file %S, line %d, characters %d-%d\")  fn lineno c1 c2\n      | _, _, Some lexbuf ->\n        file_location\n          ~pos1:(Lexing.lexeme_start_p lexbuf)\n          ~pos2:(Lexing.lexeme_end_p lexbuf)\n          ()\n      | None, None, None ->\n        s_ \"<position undefined>\"\n\n\n  let failwithpf ?pos1 ?pos2 ?lexbuf fmt =\n    let loc = file_location ?pos1 ?pos2 ?lexbuf () in\n    Printf.ksprintf (fun s -> failwith (Printf.sprintf \"%s: %s\" loc s)) fmt\n\n\nend\n\nmodule OASISUnixPath = struct\n(* # 22 \"src/oasis/OASISUnixPath.ml\" *)\n\n\n  type unix_filename = string\n  type unix_dirname = string\n\n\n  type host_filename = string\n  type host_dirname = string\n\n\n  let current_dir_name = \".\"\n\n\n  let parent_dir_name = \"..\"\n\n\n  let is_current_dir fn =\n    fn = current_dir_name || fn = \"\"\n\n\n  let concat f1 f2 =\n    if is_current_dir f1 then\n      f2\n    else\n      let f1' =\n        try OASISString.strip_ends_with ~what:\"/\" f1 with Not_found -> f1\n      in\n      f1'^\"/\"^f2\n\n\n  let make =\n    function\n      | hd :: tl ->\n        List.fold_left\n          (fun f p -> concat f p)\n          hd\n          tl\n      | [] ->\n        invalid_arg \"OASISUnixPath.make\"\n\n\n  let dirname f =\n    try\n      String.sub f 0 (String.rindex f '/')\n    with Not_found ->\n      current_dir_name\n\n\n  let basename f =\n    try\n      let pos_start =\n        (String.rindex f '/') + 1\n      in\n      String.sub f pos_start ((String.length f) - pos_start)\n    with Not_found ->\n      f\n\n\n  let chop_extension f =\n    try\n      let last_dot =\n        String.rindex f '.'\n      in\n      let sub =\n        String.sub f 0 last_dot\n      in\n      try\n        let last_slash =\n          String.rindex f '/'\n        in\n        if last_slash < last_dot then\n          sub\n        else\n          f\n      with Not_found ->\n        sub\n\n    with Not_found ->\n      f\n\n\n  let capitalize_file f =\n    let dir = dirname f in\n    let base = basename f in\n    concat dir (OASISString.capitalize_ascii base)\n\n\n  let uncapitalize_file f =\n    let dir = dirname f in\n    let base = basename f in\n    concat dir (OASISString.uncapitalize_ascii base)\n\n\nend\n\nmodule OASISHostPath = struct\n(* # 22 \"src/oasis/OASISHostPath.ml\" *)\n\n\n  open Filename\n  open OASISGettext\n\n\n  module Unix = OASISUnixPath\n\n\n  let make =\n    function\n      | [] ->\n        invalid_arg \"OASISHostPath.make\"\n      | hd :: tl ->\n        List.fold_left Filename.concat hd tl\n\n\n  let of_unix ufn =\n    match Sys.os_type with\n    | \"Unix\" | \"Cygwin\" -> ufn\n    | \"Win32\" ->\n      make\n        (List.map\n           (fun p ->\n              if p = Unix.current_dir_name then\n                current_dir_name\n              else if p = Unix.parent_dir_name then\n                parent_dir_name\n              else\n                p)\n           (OASISString.nsplit ufn '/'))\n    | os_type ->\n      OASISUtils.failwithf\n        (f_ \"Don't know the path format of os_type %S when translating unix \\\n             filename. %S\")\n        os_type ufn\n\n\nend\n\nmodule OASISFileSystem = struct\n(* # 22 \"src/oasis/OASISFileSystem.ml\" *)\n\n  (** File System functions\n\n      @author Sylvain Le Gall\n  *)\n\n  type 'a filename = string\n\n  class type closer =\n    object\n      method close: unit\n    end\n\n  class type reader =\n    object\n      inherit closer\n      method input: Buffer.t -> int -> unit\n    end\n\n  class type writer =\n    object\n      inherit closer\n      method output: Buffer.t -> unit\n    end\n\n  class type ['a] fs =\n    object\n      method string_of_filename: 'a filename -> string\n      method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer\n      method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader\n      method file_exists: 'a filename -> bool\n      method remove: 'a filename -> unit\n    end\n\n\n  module Mode =\n  struct\n    let default_in = [Open_rdonly]\n    let default_out = [Open_wronly; Open_creat; Open_trunc]\n\n    let text_in = Open_text :: default_in\n    let text_out = Open_text :: default_out\n\n    let binary_in = Open_binary :: default_in\n    let binary_out = Open_binary :: default_out\n  end\n\n  let std_length = 4096 (* Standard buffer/read length. *)\n  let binary_out = Mode.binary_out\n  let binary_in = Mode.binary_in\n\n  let of_unix_filename ufn = (ufn: 'a filename)\n  let to_unix_filename fn = (fn: string)\n\n\n  let defer_close o f =\n    try\n      let r = f o in o#close; r\n    with e ->\n      o#close; raise e\n\n\n  let stream_of_reader rdr =\n    let buf = Buffer.create std_length in\n    let pos = ref 0 in\n    let eof = ref false in\n    let rec next idx =\n      let bpos = idx - !pos in\n      if !eof then begin\n        None\n      end else if bpos < Buffer.length buf then begin\n        Some (Buffer.nth buf bpos)\n      end else begin\n        pos := !pos + Buffer.length buf;\n        Buffer.clear buf;\n        begin\n          try\n            rdr#input buf std_length;\n          with End_of_file ->\n            if Buffer.length buf = 0 then\n              eof := true\n        end;\n        next idx\n      end\n    in\n    Stream.from next\n\n\n  let read_all buf rdr =\n    try\n      while true do\n        rdr#input buf std_length\n      done\n    with End_of_file ->\n      ()\n\n  class ['a] host_fs rootdir : ['a] fs =\n    object (self)\n      method private host_filename fn = Filename.concat rootdir fn\n      method string_of_filename = self#host_filename\n\n      method open_out ?(mode=Mode.text_out)  ?(perm=0o666) fn =\n        let chn = open_out_gen mode perm (self#host_filename fn) in\n        object\n          method close = close_out chn\n          method output buf = Buffer.output_buffer chn buf\n        end\n\n      method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn =\n        (* TODO: use Buffer.add_channel when minimal version of OCaml will\n         * be >= 4.03.0 (previous version was discarding last chars).\n         *)\n        let chn = open_in_gen mode perm (self#host_filename fn) in\n        let strm = Stream.of_channel chn in\n        object\n          method close = close_in chn\n          method input buf len =\n            let read = ref 0 in\n            try\n              for _i = 0 to len do\n                Buffer.add_char buf (Stream.next strm);\n                incr read\n              done\n            with Stream.Failure ->\n              if !read = 0 then\n                raise End_of_file\n        end\n\n      method file_exists fn = Sys.file_exists (self#host_filename fn)\n      method remove fn = Sys.remove (self#host_filename fn)\n    end\n\nend\n\nmodule OASISContext = struct\n(* # 22 \"src/oasis/OASISContext.ml\" *)\n\n\n  open OASISGettext\n\n\n  type level =\n    [ `Debug\n    | `Info\n    | `Warning\n    | `Error]\n\n\n  type source\n  type source_filename = source OASISFileSystem.filename\n\n\n  let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn\n\n\n  type t =\n    {\n      (* TODO: replace this by a proplist. *)\n      quiet:                 bool;\n      info:                  bool;\n      debug:                 bool;\n      ignore_plugins:        bool;\n      ignore_unknown_fields: bool;\n      printf:                level -> string -> unit;\n      srcfs:                 source OASISFileSystem.fs;\n      load_oasis_plugin:     string -> bool;\n    }\n\n\n  let printf lvl str =\n    let beg =\n      match lvl with\n        | `Error -> s_ \"E: \"\n        | `Warning -> s_ \"W: \"\n        | `Info  -> s_ \"I: \"\n        | `Debug -> s_ \"D: \"\n    in\n    prerr_endline (beg^str)\n\n\n  let default =\n    ref\n      {\n        quiet                 = false;\n        info                  = false;\n        debug                 = false;\n        ignore_plugins        = false;\n        ignore_unknown_fields = false;\n        printf                = printf;\n        srcfs                 = new OASISFileSystem.host_fs(Sys.getcwd ());\n        load_oasis_plugin     = (fun _ -> false);\n      }\n\n\n  let quiet =\n    {!default with quiet = true}\n\n\n  let fspecs () =\n    (* TODO: don't act on default. *)\n    let ignore_plugins = ref false in\n    [\"-quiet\",\n     Arg.Unit (fun () -> default := {!default with quiet = true}),\n     s_ \" Run quietly\";\n\n     \"-info\",\n     Arg.Unit (fun () -> default := {!default with info = true}),\n     s_ \" Display information message\";\n\n\n     \"-debug\",\n     Arg.Unit (fun () -> default := {!default with debug = true}),\n     s_ \" Output debug message\";\n\n     \"-ignore-plugins\",\n     Arg.Set ignore_plugins,\n     s_ \" Ignore plugin's field.\";\n\n     \"-C\",\n     Arg.String\n       (fun str ->\n          Sys.chdir str;\n          default := {!default with srcfs = new OASISFileSystem.host_fs str}),\n     s_ \"dir Change directory before running (affects setup.{data,log}).\"],\n    fun () -> {!default with ignore_plugins = !ignore_plugins}\nend\n\nmodule PropList = struct\n(* # 22 \"src/oasis/PropList.ml\" *)\n\n\n  open OASISGettext\n\n\n  type name = string\n\n\n  exception Not_set of name * string option\n  exception No_printer of name\n  exception Unknown_field of name * name\n\n\n  let () =\n    Printexc.register_printer\n      (function\n        | Not_set (nm, Some rsn) ->\n          Some\n            (Printf.sprintf (f_ \"Field '%s' is not set: %s\") nm rsn)\n        | Not_set (nm, None) ->\n          Some\n            (Printf.sprintf (f_ \"Field '%s' is not set\") nm)\n        | No_printer nm ->\n          Some\n            (Printf.sprintf (f_ \"No default printer for value %s\") nm)\n        | Unknown_field (nm, schm) ->\n          Some\n            (Printf.sprintf\n               (f_ \"Field %s is not defined in schema %s\") nm schm)\n        | _ ->\n          None)\n\n\n  module Data =\n  struct\n    type t =\n      (name, unit -> unit) Hashtbl.t\n\n    let create () =\n      Hashtbl.create 13\n\n    let clear t =\n      Hashtbl.clear t\n\n\n(* # 77 \"src/oasis/PropList.ml\" *)\n  end\n\n\n  module Schema =\n  struct\n    type ('ctxt, 'extra) value =\n      {\n        get:   Data.t -> string;\n        set:   Data.t -> ?context:'ctxt -> string -> unit;\n        help:  (unit -> string) option;\n        extra: 'extra;\n      }\n\n    type ('ctxt, 'extra) t =\n      {\n        name:      name;\n        fields:    (name, ('ctxt, 'extra) value) Hashtbl.t;\n        order:     name Queue.t;\n        name_norm: string -> string;\n      }\n\n    let create ?(case_insensitive=false) nm =\n      {\n        name      = nm;\n        fields    = Hashtbl.create 13;\n        order     = Queue.create ();\n        name_norm =\n          (if case_insensitive then\n             OASISString.lowercase_ascii\n           else\n             fun s -> s);\n      }\n\n    let add t nm set get extra help =\n      let key =\n        t.name_norm nm\n      in\n\n      if Hashtbl.mem t.fields key then\n        failwith\n          (Printf.sprintf\n             (f_ \"Field '%s' is already defined in schema '%s'\")\n             nm t.name);\n      Hashtbl.add\n        t.fields\n        key\n        {\n          set   = set;\n          get   = get;\n          help  = help;\n          extra = extra;\n        };\n      Queue.add nm t.order\n\n    let mem t nm =\n      Hashtbl.mem t.fields nm\n\n    let find t nm =\n      try\n        Hashtbl.find t.fields (t.name_norm nm)\n      with Not_found ->\n        raise (Unknown_field (nm, t.name))\n\n    let get t data nm =\n      (find t nm).get data\n\n    let set t data nm ?context x =\n      (find t nm).set\n        data\n        ?context\n        x\n\n    let fold f acc t =\n      Queue.fold\n        (fun acc k ->\n           let v =\n             find t k\n           in\n           f acc k v.extra v.help)\n        acc\n        t.order\n\n    let iter f t =\n      fold\n        (fun () -> f)\n        ()\n        t\n\n    let name t =\n      t.name\n  end\n\n\n  module Field =\n  struct\n    type ('ctxt, 'value, 'extra) t =\n      {\n        set:    Data.t -> ?context:'ctxt -> 'value -> unit;\n        get:    Data.t -> 'value;\n        sets:   Data.t -> ?context:'ctxt -> string -> unit;\n        gets:   Data.t -> string;\n        help:   (unit -> string) option;\n        extra:  'extra;\n      }\n\n    let new_id =\n      let last_id =\n        ref 0\n      in\n      fun () -> incr last_id; !last_id\n\n    let create ?schema ?name ?parse ?print ?default ?update ?help extra =\n      (* Default value container *)\n      let v =\n        ref None\n      in\n\n      (* If name is not given, create unique one *)\n      let nm =\n        match name with\n          | Some s -> s\n          | None -> Printf.sprintf \"_anon_%d\" (new_id ())\n      in\n\n      (* Last chance to get a value: the default *)\n      let default () =\n        match default with\n          | Some d -> d\n          | None -> raise (Not_set (nm, Some (s_ \"no default value\")))\n      in\n\n      (* Get data *)\n      let get data =\n        (* Get value *)\n        try\n          (Hashtbl.find data nm) ();\n          match !v with\n            | Some x -> x\n            | None -> default ()\n        with Not_found ->\n          default ()\n      in\n\n      (* Set data *)\n      let set data ?context x =\n        let x =\n          match update with\n            | Some f ->\n              begin\n                try\n                  f ?context (get data) x\n                with Not_set _ ->\n                  x\n              end\n            | None ->\n              x\n        in\n        Hashtbl.replace\n          data\n          nm\n          (fun () -> v := Some x)\n      in\n\n      (* Parse string value, if possible *)\n      let parse =\n        match parse with\n          | Some f ->\n            f\n          | None ->\n            fun ?context s ->\n              failwith\n                (Printf.sprintf\n                   (f_ \"Cannot parse field '%s' when setting value %S\")\n                   nm\n                   s)\n      in\n\n      (* Set data, from string *)\n      let sets data ?context s =\n        set ?context data (parse ?context s)\n      in\n\n      (* Output value as string, if possible *)\n      let print =\n        match print with\n          | Some f ->\n            f\n          | None ->\n            fun _ -> raise (No_printer nm)\n      in\n\n      (* Get data, as a string *)\n      let gets data =\n        print (get data)\n      in\n\n      begin\n        match schema with\n          | Some t ->\n            Schema.add t nm sets gets extra help\n          | None ->\n            ()\n      end;\n\n      {\n        set   = set;\n        get   = get;\n        sets  = sets;\n        gets  = gets;\n        help  = help;\n        extra = extra;\n      }\n\n    let fset data t ?context x =\n      t.set data ?context x\n\n    let fget data t =\n      t.get data\n\n    let fsets data t ?context s =\n      t.sets data ?context s\n\n    let fgets data t =\n      t.gets data\n  end\n\n\n  module FieldRO =\n  struct\n    let create ?schema ?name ?parse ?print ?default ?update ?help extra =\n      let fld =\n        Field.create ?schema ?name ?parse ?print ?default ?update ?help extra\n      in\n      fun data -> Field.fget data fld\n  end\nend\n\nmodule OASISMessage = struct\n(* # 22 \"src/oasis/OASISMessage.ml\" *)\n\n\n  open OASISGettext\n  open OASISContext\n\n\n  let generic_message ~ctxt lvl fmt =\n    let cond =\n      if ctxt.quiet then\n        false\n      else\n        match lvl with\n          | `Debug -> ctxt.debug\n          | `Info  -> ctxt.info\n          | _ -> true\n    in\n    Printf.ksprintf\n      (fun str ->\n         if cond then\n           begin\n             ctxt.printf lvl str\n           end)\n      fmt\n\n\n  let debug ~ctxt fmt =\n    generic_message ~ctxt `Debug fmt\n\n\n  let info ~ctxt fmt =\n    generic_message ~ctxt `Info fmt\n\n\n  let warning ~ctxt fmt =\n    generic_message ~ctxt `Warning fmt\n\n\n  let error ~ctxt fmt =\n    generic_message ~ctxt `Error fmt\n\nend\n\nmodule OASISVersion = struct\n(* # 22 \"src/oasis/OASISVersion.ml\" *)\n\n\n  open OASISGettext\n\n\n  type t = string\n\n\n  type comparator =\n    | VGreater of t\n    | VGreaterEqual of t\n    | VEqual of t\n    | VLesser of t\n    | VLesserEqual of t\n    | VOr of  comparator * comparator\n    | VAnd of comparator * comparator\n\n\n  (* Range of allowed characters *)\n  let is_digit c = '0' <= c && c <= '9'\n  let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')\n  let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false\n\n\n  let rec version_compare v1 v2 =\n    if v1 <> \"\" || v2 <> \"\" then\n      begin\n        (* Compare ascii string, using special meaning for version\n         * related char\n        *)\n        let val_ascii c =\n          if c = '~' then -1\n          else if is_digit c then 0\n          else if c = '\\000' then 0\n          else if is_alpha c then Char.code c\n          else (Char.code c) + 256\n        in\n\n        let len1 = String.length v1 in\n        let len2 = String.length v2 in\n\n        let p = ref 0 in\n\n        (** Compare ascii part *)\n        let compare_vascii () =\n          let cmp = ref 0 in\n          while !cmp = 0 &&\n                !p < len1 && !p < len2 &&\n                not (is_digit v1.[!p] && is_digit v2.[!p]) do\n            cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);\n            incr p\n          done;\n          if !cmp = 0 && !p < len1 && !p = len2 then\n            val_ascii v1.[!p]\n          else if !cmp = 0 && !p = len1 && !p < len2 then\n            - (val_ascii v2.[!p])\n          else\n            !cmp\n        in\n\n        (** Compare digit part *)\n        let compare_digit () =\n          let extract_int v p =\n            let start_p = !p in\n            while !p < String.length v && is_digit v.[!p] do\n              incr p\n            done;\n            let substr =\n              String.sub v !p ((String.length v) - !p)\n            in\n            let res =\n              match String.sub v start_p (!p - start_p) with\n                | \"\" -> 0\n                | s -> int_of_string s\n            in\n            res, substr\n          in\n          let i1, tl1 = extract_int v1 (ref !p) in\n          let i2, tl2 = extract_int v2 (ref !p) in\n          i1 - i2, tl1, tl2\n        in\n\n        match compare_vascii () with\n          | 0 ->\n            begin\n              match compare_digit () with\n                | 0, tl1, tl2 ->\n                  if tl1 <> \"\" && is_digit tl1.[0] then\n                    1\n                  else if tl2 <> \"\" && is_digit tl2.[0] then\n                    -1\n                  else\n                    version_compare tl1 tl2\n                | n, _, _ ->\n                  n\n            end\n          | n ->\n            n\n      end\n    else begin\n      0\n    end\n\n\n  let version_of_string str = str\n\n\n  let string_of_version t = t\n\n\n  let chop t =\n    try\n      let pos =\n        String.rindex t '.'\n      in\n      String.sub t 0 pos\n    with Not_found ->\n      t\n\n\n  let rec comparator_apply v op =\n    match op with\n      | VGreater cv ->\n        (version_compare v cv) > 0\n      | VGreaterEqual cv ->\n        (version_compare v cv) >= 0\n      | VLesser cv ->\n        (version_compare v cv) < 0\n      | VLesserEqual cv ->\n        (version_compare v cv) <= 0\n      | VEqual cv ->\n        (version_compare v cv) = 0\n      | VOr (op1, op2) ->\n        (comparator_apply v op1) || (comparator_apply v op2)\n      | VAnd (op1, op2) ->\n        (comparator_apply v op1) && (comparator_apply v op2)\n\n\n  let rec string_of_comparator =\n    function\n      | VGreater v  -> \"> \"^(string_of_version v)\n      | VEqual v    -> \"= \"^(string_of_version v)\n      | VLesser v   -> \"< \"^(string_of_version v)\n      | VGreaterEqual v -> \">= \"^(string_of_version v)\n      | VLesserEqual v  -> \"<= \"^(string_of_version v)\n      | VOr (c1, c2)  ->\n        (string_of_comparator c1)^\" || \"^(string_of_comparator c2)\n      | VAnd (c1, c2) ->\n        (string_of_comparator c1)^\" && \"^(string_of_comparator c2)\n\n\n  let rec varname_of_comparator =\n    let concat p v =\n      OASISUtils.varname_concat\n        p\n        (OASISUtils.varname_of_string\n           (string_of_version v))\n    in\n    function\n      | VGreater v -> concat \"gt\" v\n      | VLesser v  -> concat \"lt\" v\n      | VEqual v   -> concat \"eq\" v\n      | VGreaterEqual v -> concat \"ge\" v\n      | VLesserEqual v  -> concat \"le\" v\n      | VOr (c1, c2) ->\n        (varname_of_comparator c1)^\"_or_\"^(varname_of_comparator c2)\n      | VAnd (c1, c2) ->\n        (varname_of_comparator c1)^\"_and_\"^(varname_of_comparator c2)\n\n\nend\n\nmodule OASISLicense = struct\n(* # 22 \"src/oasis/OASISLicense.ml\" *)\n\n\n  (** License for _oasis fields\n      @author Sylvain Le Gall\n  *)\n\n\n  type license = string\n  type license_exception = string\n\n\n  type license_version =\n    | Version of OASISVersion.t\n    | VersionOrLater of OASISVersion.t\n    | NoVersion\n\n\n  type license_dep_5_unit =\n    {\n      license:   license;\n      excption:  license_exception option;\n      version:   license_version;\n    }\n\n\n  type license_dep_5 =\n    | DEP5Unit of license_dep_5_unit\n    | DEP5Or of license_dep_5 list\n    | DEP5And of license_dep_5 list\n\n\n  type t =\n    | DEP5License of license_dep_5\n    | OtherLicense of string (* URL *)\n\n\nend\n\nmodule OASISExpr = struct\n(* # 22 \"src/oasis/OASISExpr.ml\" *)\n\n\n  open OASISGettext\n  open OASISUtils\n\n\n  type test = string\n  type flag = string\n\n\n  type t =\n    | EBool of bool\n    | ENot of t\n    | EAnd of t * t\n    | EOr of t * t\n    | EFlag of flag\n    | ETest of test * string\n\n\n  type 'a choices = (t * 'a) list\n\n\n  let eval var_get t =\n    let rec eval' =\n      function\n        | EBool b ->\n            b\n\n        | ENot e ->\n            not (eval' e)\n\n        | EAnd (e1, e2) ->\n            (eval' e1) && (eval' e2)\n\n        | EOr (e1, e2) ->\n            (eval' e1) || (eval' e2)\n\n        | EFlag nm ->\n            let v =\n              var_get nm\n            in\n              assert(v = \"true\" || v = \"false\");\n              (v = \"true\")\n\n        | ETest (nm, vl) ->\n            let v =\n              var_get nm\n            in\n              (v = vl)\n    in\n      eval' t\n\n\n  let choose ?printer ?name var_get lst =\n    let rec choose_aux =\n      function\n        | (cond, vl) :: tl ->\n            if eval var_get cond then\n              vl\n            else\n              choose_aux tl\n        | [] ->\n            let str_lst =\n              if lst = [] then\n                s_ \"<empty>\"\n              else\n                String.concat\n                  (s_ \", \")\n                  (List.map\n                     (fun (cond, vl) ->\n                        match printer with\n                          | Some p -> p vl\n                          | None -> s_ \"<no printer>\")\n                     lst)\n            in\n              match name with\n                | Some nm ->\n                    failwith\n                      (Printf.sprintf\n                         (f_ \"No result for the choice list '%s': %s\")\n                         nm str_lst)\n                | None ->\n                    failwith\n                      (Printf.sprintf\n                         (f_ \"No result for a choice list: %s\")\n                         str_lst)\n    in\n      choose_aux (List.rev lst)\n\n\nend\n\nmodule OASISText = struct\n(* # 22 \"src/oasis/OASISText.ml\" *)\n\n  type elt =\n    | Para of string\n    | Verbatim of string\n    | BlankLine\n\n  type t = elt list\n\nend\n\nmodule OASISSourcePatterns = struct\n(* # 22 \"src/oasis/OASISSourcePatterns.ml\" *)\n\n  open OASISUtils\n  open OASISGettext\n\n  module Templater =\n  struct\n    (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *)\n    type t =\n      {\n        atoms: atom list;\n        origin: string\n      }\n    and atom =\n      | Text of string\n      | Expr of expr\n    and expr =\n      | Ident of string\n      | String of string\n      | Call of string * expr\n\n\n    type env =\n      {\n        variables: string MapString.t;\n        functions: (string -> string) MapString.t;\n      }\n\n\n    let eval env t =\n      let rec eval_expr env =\n        function\n        | String str -> str\n        | Ident nm ->\n          begin\n            try\n              MapString.find nm env.variables\n            with Not_found ->\n              (* TODO: add error location within the string. *)\n              failwithf\n                (f_ \"Unable to find variable %S in source pattern %S\")\n                nm t.origin\n          end\n\n        | Call (fn, expr) ->\n          begin\n            try\n              (MapString.find fn env.functions) (eval_expr env expr)\n            with Not_found ->\n              (* TODO: add error location within the string. *)\n              failwithf\n                (f_ \"Unable to find function %S in source pattern %S\")\n                fn t.origin\n          end\n      in\n      String.concat \"\"\n        (List.map\n           (function\n             | Text str -> str\n             | Expr expr -> eval_expr env expr)\n           t.atoms)\n\n\n    let parse env s =\n      let lxr = Genlex.make_lexer [] in\n      let parse_expr s =\n        let st = lxr (Stream.of_string s) in\n        match Stream.npeek 3 st with\n        | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm)\n        | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str)\n        | [Genlex.String str] -> String str\n        | [Genlex.Ident nm] -> Ident nm\n        (* TODO: add error location within the string. *)\n        | _ -> failwithf (f_ \"Unable to parse expression %S\") s\n      in\n      let parse s =\n        let lst_exprs = ref [] in\n        let ss =\n          let buff = Buffer.create (String.length s) in\n          Buffer.add_substitute\n            buff\n            (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; \"\\000\")\n            s;\n          Buffer.contents buff\n        in\n        let rec join =\n          function\n          | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2)\n          | [], tl -> List.map (fun e -> Expr e) tl\n          | tl, [] -> List.map (fun e -> Text e) tl\n        in\n        join (OASISString.nsplit ss '\\000', List.rev (!lst_exprs))\n      in\n      let t = {atoms = parse s; origin = s} in\n      (* We rely on a simple evaluation for checking variables/functions.\n         It works because there is no if/loop statement.\n      *)\n      let _s : string = eval env t in\n      t\n\n(* # 144 \"src/oasis/OASISSourcePatterns.ml\" *)\n  end\n\n\n  type t = Templater.t\n\n\n  let env ~modul () =\n    {\n      Templater.\n      variables = MapString.of_list [\"module\", modul];\n      functions = MapString.of_list\n          [\n            \"capitalize_file\", OASISUnixPath.capitalize_file;\n            \"uncapitalize_file\", OASISUnixPath.uncapitalize_file;\n          ];\n    }\n\n  let all_possible_files lst ~path ~modul =\n    let eval = Templater.eval (env ~modul ()) in\n    List.fold_left\n      (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc)\n      [] lst\n\n\n  let to_string t = t.Templater.origin\n\n\nend\n\nmodule OASISTypes = struct\n(* # 22 \"src/oasis/OASISTypes.ml\" *)\n\n\n  type name          = string\n  type package_name  = string\n  type url           = string\n  type unix_dirname  = string\n  type unix_filename = string (* TODO: replace everywhere. *)\n  type host_dirname  = string (* TODO: replace everywhere. *)\n  type host_filename = string (* TODO: replace everywhere. *)\n  type prog          = string\n  type arg           = string\n  type args          = string list\n  type command_line  = (prog * arg list)\n\n\n  type findlib_name = string\n  type findlib_full = string\n\n\n  type compiled_object =\n    | Byte\n    | Native\n    | Best\n\n\n  type dependency =\n    | FindlibPackage of findlib_full * OASISVersion.comparator option\n    | InternalLibrary of name\n\n\n  type tool =\n    | ExternalTool of name\n    | InternalExecutable of name\n\n\n  type vcs =\n    | Darcs\n    | Git\n    | Svn\n    | Cvs\n    | Hg\n    | Bzr\n    | Arch\n    | Monotone\n    | OtherVCS of url\n\n\n  type plugin_kind =\n    [  `Configure\n    | `Build\n    | `Doc\n    | `Test\n    | `Install\n    | `Extra\n    ]\n\n\n  type plugin_data_purpose =\n    [  `Configure\n    | `Build\n    | `Install\n    | `Clean\n    | `Distclean\n    | `Install\n    | `Uninstall\n    | `Test\n    | `Doc\n    | `Extra\n    | `Other of string\n    ]\n\n\n  type 'a plugin = 'a * name * OASISVersion.t option\n\n\n  type all_plugin = plugin_kind plugin\n\n\n  type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list\n\n\n  type 'a conditional = 'a OASISExpr.choices\n\n\n  type custom =\n    {\n      pre_command:  (command_line option) conditional;\n      post_command: (command_line option) conditional;\n    }\n\n\n  type common_section =\n    {\n      cs_name: name;\n      cs_data: PropList.Data.t;\n      cs_plugin_data: plugin_data;\n    }\n\n\n  type build_section =\n    {\n      bs_build:                   bool conditional;\n      bs_install:                 bool conditional;\n      bs_path:                    unix_dirname;\n      bs_compiled_object:         compiled_object;\n      bs_build_depends:           dependency list;\n      bs_build_tools:             tool list;\n      bs_interface_patterns:      OASISSourcePatterns.t list;\n      bs_implementation_patterns: OASISSourcePatterns.t list;\n      bs_c_sources:               unix_filename list;\n      bs_data_files:              (unix_filename * unix_filename option) list;\n      bs_findlib_extra_files:     unix_filename list;\n      bs_ccopt:                   args conditional;\n      bs_cclib:                   args conditional;\n      bs_dlllib:                  args conditional;\n      bs_dllpath:                 args conditional;\n      bs_byteopt:                 args conditional;\n      bs_nativeopt:               args conditional;\n    }\n\n\n  type library =\n    {\n      lib_modules:            string list;\n      lib_pack:               bool;\n      lib_internal_modules:   string list;\n      lib_findlib_parent:     findlib_name option;\n      lib_findlib_name:       findlib_name option;\n      lib_findlib_directory:  unix_dirname option;\n      lib_findlib_containers: findlib_name list;\n    }\n\n\n  type object_ =\n    {\n      obj_modules:            string list;\n      obj_findlib_fullname:   findlib_name list option;\n      obj_findlib_directory:  unix_dirname option;\n    }\n\n\n  type executable =\n    {\n      exec_custom:          bool;\n      exec_main_is:         unix_filename;\n    }\n\n\n  type flag =\n    {\n      flag_description:  string option;\n      flag_default:      bool conditional;\n    }\n\n\n  type source_repository =\n    {\n      src_repo_type:        vcs;\n      src_repo_location:    url;\n      src_repo_browser:     url option;\n      src_repo_module:      string option;\n      src_repo_branch:      string option;\n      src_repo_tag:         string option;\n      src_repo_subdir:      unix_filename option;\n    }\n\n\n  type test =\n    {\n      test_type:               [`Test] plugin;\n      test_command:            command_line conditional;\n      test_custom:             custom;\n      test_working_directory:  unix_filename option;\n      test_run:                bool conditional;\n      test_tools:              tool list;\n    }\n\n\n  type doc_format =\n    | HTML of unix_filename (* TODO: source filename. *)\n    | DocText\n    | PDF\n    | PostScript\n    | Info of unix_filename (* TODO: source filename. *)\n    | DVI\n    | OtherDoc\n\n\n  type doc =\n    {\n      doc_type:        [`Doc] plugin;\n      doc_custom:      custom;\n      doc_build:       bool conditional;\n      doc_install:     bool conditional;\n      doc_install_dir: unix_filename; (* TODO: dest filename ?. *)\n      doc_title:       string;\n      doc_authors:     string list;\n      doc_abstract:    string option;\n      doc_format:      doc_format;\n      (* TODO: src filename. *)\n      doc_data_files:  (unix_filename * unix_filename option) list;\n      doc_build_tools: tool list;\n    }\n\n\n  type section =\n    | Library    of common_section * build_section * library\n    | Object     of common_section * build_section * object_\n    | Executable of common_section * build_section * executable\n    | Flag       of common_section * flag\n    | SrcRepo    of common_section * source_repository\n    | Test       of common_section * test\n    | Doc        of common_section * doc\n\n\n  type section_kind =\n    [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]\n\n\n  type package =\n    {\n      oasis_version:          OASISVersion.t;\n      ocaml_version:          OASISVersion.comparator option;\n      findlib_version:        OASISVersion.comparator option;\n      alpha_features:         string list;\n      beta_features:          string list;\n      name:                   package_name;\n      version:                OASISVersion.t;\n      license:                OASISLicense.t;\n      license_file:           unix_filename option; (* TODO: source filename. *)\n      copyrights:             string list;\n      maintainers:            string list;\n      authors:                string list;\n      homepage:               url option;\n      bugreports:             url option;\n      synopsis:               string;\n      description:            OASISText.t option;\n      tags:                   string list;\n      categories:             url list;\n\n      conf_type:              [`Configure] plugin;\n      conf_custom:            custom;\n\n      build_type:             [`Build] plugin;\n      build_custom:           custom;\n\n      install_type:           [`Install] plugin;\n      install_custom:         custom;\n      uninstall_custom:       custom;\n\n      clean_custom:           custom;\n      distclean_custom:       custom;\n\n      files_ab:               unix_filename list; (* TODO: source filename. *)\n      sections:               section list;\n      plugins:                [`Extra] plugin list;\n      disable_oasis_section:  unix_filename list; (* TODO: source filename. *)\n      schema_data:            PropList.Data.t;\n      plugin_data:            plugin_data;\n    }\n\n\nend\n\nmodule OASISFeatures = struct\n(* # 22 \"src/oasis/OASISFeatures.ml\" *)\n\n  open OASISTypes\n  open OASISUtils\n  open OASISGettext\n  open OASISVersion\n\n  module MapPlugin =\n    Map.Make\n      (struct\n        type t = plugin_kind * name\n        let compare = Pervasives.compare\n      end)\n\n  module Data =\n  struct\n    type t =\n      {\n        oasis_version: OASISVersion.t;\n        plugin_versions: OASISVersion.t option MapPlugin.t;\n        alpha_features: string list;\n        beta_features: string list;\n      }\n\n    let create oasis_version alpha_features beta_features =\n      {\n        oasis_version = oasis_version;\n        plugin_versions = MapPlugin.empty;\n        alpha_features = alpha_features;\n        beta_features = beta_features\n      }\n\n    let of_package pkg =\n      create\n        pkg.OASISTypes.oasis_version\n        pkg.OASISTypes.alpha_features\n        pkg.OASISTypes.beta_features\n\n    let add_plugin (plugin_kind, plugin_name, plugin_version) t =\n      {t with\n         plugin_versions = MapPlugin.add\n             (plugin_kind, plugin_name)\n             plugin_version\n             t.plugin_versions}\n\n    let plugin_version plugin_kind plugin_name t =\n      MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions\n\n    let to_string t =\n      Printf.sprintf\n        \"oasis_version: %s; alpha_features: %s; beta_features: %s; \\\n         plugins_version: %s\"\n        (OASISVersion.string_of_version (t:t).oasis_version)\n        (String.concat \", \" t.alpha_features)\n        (String.concat \", \" t.beta_features)\n        (String.concat \", \"\n           (MapPlugin.fold\n              (fun (_, plg) ver_opt acc ->\n                 (plg^\n                    (match ver_opt with\n                      | Some v ->\n                        \" \"^(OASISVersion.string_of_version v)\n                      | None -> \"\"))\n                 :: acc)\n              t.plugin_versions []))\n  end\n\n  type origin =\n    | Field of string * string\n    | Section of string\n    | NoOrigin\n\n  type stage = Alpha | Beta\n\n\n  let string_of_stage =\n    function\n    | Alpha -> \"alpha\"\n    | Beta -> \"beta\"\n\n\n  let field_of_stage =\n    function\n    | Alpha -> \"AlphaFeatures\"\n    | Beta -> \"BetaFeatures\"\n\n  type publication = InDev of stage | SinceVersion of OASISVersion.t\n\n  type t =\n    {\n      name: string;\n      plugin: all_plugin option;\n      publication: publication;\n      description: unit -> string;\n    }\n\n  (* TODO: mutex protect this. *)\n  let all_features = Hashtbl.create 13\n\n\n  let since_version ver_str = SinceVersion (version_of_string ver_str)\n  let alpha = InDev Alpha\n  let beta = InDev Beta\n\n\n  let to_string t =\n    Printf.sprintf\n      \"feature: %s; plugin: %s; publication: %s\"\n      (t:t).name\n      (match t.plugin with\n       | None -> \"<none>\"\n       | Some (_, nm, _) -> nm)\n      (match t.publication with\n       | InDev stage -> string_of_stage stage\n       | SinceVersion ver -> \">= \"^(OASISVersion.string_of_version ver))\n\n  let data_check t data origin =\n    let no_message = \"no message\" in\n\n    let check_feature features stage =\n      let has_feature = List.mem (t:t).name features in\n      if not has_feature then\n        match (origin:origin) with\n        | Field (fld, where) ->\n          Some\n            (Printf.sprintf\n               (f_ \"Field %s in %s is only available when feature %s \\\n                    is in field %s.\")\n               fld where t.name (field_of_stage stage))\n        | Section sct ->\n          Some\n            (Printf.sprintf\n               (f_ \"Section %s is only available when features %s \\\n                    is in field %s.\")\n               sct t.name (field_of_stage stage))\n        | NoOrigin ->\n          Some no_message\n      else\n        None\n    in\n\n    let version_is_good ~min_version version fmt =\n      let version_is_good =\n        OASISVersion.comparator_apply\n          version (OASISVersion.VGreaterEqual min_version)\n      in\n      Printf.ksprintf\n        (fun str -> if version_is_good then None else Some str)\n        fmt\n    in\n\n    match origin, t.plugin, t.publication with\n    | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha\n    | _, _, InDev Beta -> check_feature data.Data.beta_features Beta\n    | Field(fld, where), None, SinceVersion min_version ->\n      version_is_good ~min_version data.Data.oasis_version\n        (f_ \"Field %s in %s is only valid since OASIS v%s, update \\\n             OASISFormat field from '%s' to '%s' after checking \\\n             OASIS changelog.\")\n        fld where (string_of_version min_version)\n        (string_of_version data.Data.oasis_version)\n        (string_of_version min_version)\n\n    | Field(fld, where), Some(plugin_knd, plugin_name, _),\n      SinceVersion min_version ->\n      begin\n        try\n          let plugin_version_current =\n            try\n              match Data.plugin_version plugin_knd plugin_name data with\n              | Some ver -> ver\n              | None ->\n                failwithf\n                  (f_ \"Field %s in %s is only valid for the OASIS \\\n                       plugin %s since v%s, but no plugin version is \\\n                       defined in the _oasis file, change '%s' to \\\n                       '%s (%s)' in your _oasis file.\")\n                  fld where plugin_name (string_of_version min_version)\n                  plugin_name\n                  plugin_name (string_of_version min_version)\n            with Not_found ->\n              failwithf\n                (f_ \"Field %s in %s is only valid when the OASIS plugin %s \\\n                     is defined.\")\n                fld where plugin_name\n          in\n          version_is_good ~min_version plugin_version_current\n            (f_ \"Field %s in %s is only valid for the OASIS plugin %s \\\n                 since v%s, update your plugin from '%s (%s)' to \\\n                 '%s (%s)' after checking the plugin's changelog.\")\n            fld where plugin_name (string_of_version min_version)\n            plugin_name (string_of_version plugin_version_current)\n            plugin_name (string_of_version min_version)\n        with Failure msg ->\n          Some msg\n      end\n\n    | Section sct, None, SinceVersion min_version ->\n      version_is_good ~min_version data.Data.oasis_version\n        (f_ \"Section %s is only valid for since OASIS v%s, update \\\n             OASISFormat field from '%s' to '%s' after checking OASIS \\\n             changelog.\")\n        sct (string_of_version min_version)\n        (string_of_version data.Data.oasis_version)\n        (string_of_version min_version)\n\n    | Section sct, Some(plugin_knd, plugin_name, _),\n      SinceVersion min_version ->\n      begin\n        try\n          let plugin_version_current =\n            try\n              match Data.plugin_version plugin_knd plugin_name data with\n              | Some ver -> ver\n              | None ->\n                failwithf\n                  (f_ \"Section %s is only valid for the OASIS \\\n                       plugin %s since v%s, but no plugin version is \\\n                       defined in the _oasis file, change '%s' to \\\n                       '%s (%s)' in your _oasis file.\")\n                  sct plugin_name (string_of_version min_version)\n                  plugin_name\n                  plugin_name (string_of_version min_version)\n            with Not_found ->\n              failwithf\n                (f_ \"Section %s is only valid when the OASIS plugin %s \\\n                     is defined.\")\n                sct plugin_name\n          in\n          version_is_good ~min_version plugin_version_current\n            (f_ \"Section %s is only valid for the OASIS plugin %s \\\n                 since v%s, update your plugin from '%s (%s)' to \\\n                 '%s (%s)' after checking the plugin's changelog.\")\n            sct plugin_name (string_of_version min_version)\n            plugin_name (string_of_version plugin_version_current)\n            plugin_name (string_of_version min_version)\n        with Failure msg ->\n          Some msg\n      end\n\n    | NoOrigin, None, SinceVersion min_version ->\n      version_is_good ~min_version data.Data.oasis_version \"%s\" no_message\n\n    | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->\n      begin\n        try\n          let plugin_version_current =\n            match Data.plugin_version plugin_knd plugin_name data with\n            | Some ver -> ver\n            | None -> raise Not_found\n          in\n          version_is_good ~min_version plugin_version_current\n            \"%s\" no_message\n        with Not_found ->\n          Some no_message\n      end\n\n\n  let data_assert t data origin =\n    match data_check t data origin with\n    | None -> ()\n    | Some str -> failwith str\n\n\n  let data_test t data =\n    match data_check t data NoOrigin with\n    | None -> true\n    | Some _ -> false\n\n\n  let package_test t pkg =\n    data_test t (Data.of_package pkg)\n\n\n  let create ?plugin name publication description =\n    let () =\n      if Hashtbl.mem all_features name then\n        failwithf \"Feature '%s' is already declared.\" name\n    in\n    let t =\n      {\n        name = name;\n        plugin = plugin;\n        publication = publication;\n        description = description;\n      }\n    in\n    Hashtbl.add all_features name t;\n    t\n\n\n  let get_stage name =\n    try\n      (Hashtbl.find all_features name).publication\n    with Not_found ->\n      failwithf (f_ \"Feature %s doesn't exist.\") name\n\n\n  let list () =\n    Hashtbl.fold (fun _ v acc -> v :: acc) all_features []\n\n  (*\n   * Real flags.\n   *)\n\n\n  let features =\n    create \"features_fields\"\n      (since_version \"0.4\")\n      (fun () ->\n         s_ \"Enable to experiment not yet official features.\")\n\n\n  let flag_docs =\n    create \"flag_docs\"\n      (since_version \"0.3\")\n      (fun () ->\n         s_ \"Make building docs require '-docs' flag at configure.\")\n\n\n  let flag_tests =\n    create \"flag_tests\"\n      (since_version \"0.3\")\n      (fun () ->\n         s_ \"Make running tests require '-tests' flag at configure.\")\n\n\n  let pack =\n    create \"pack\"\n      (since_version \"0.3\")\n      (fun () ->\n         s_ \"Allow to create packed library.\")\n\n\n  let section_object =\n    create \"section_object\" beta\n      (fun () ->\n         s_ \"Implement an object section.\")\n\n\n  let dynrun_for_release =\n    create \"dynrun_for_release\" alpha\n      (fun () ->\n         s_ \"Make '-setup-update dynamic' suitable for releasing project.\")\n\n\n  let compiled_setup_ml =\n    create \"compiled_setup_ml\" alpha\n      (fun () ->\n         s_ \"Compile the setup.ml and speed-up actions done with it.\")\n\n  let disable_oasis_section =\n    create \"disable_oasis_section\" alpha\n      (fun () ->\n         s_ \"Allow the OASIS section comments and digests to be omitted in \\\n             generated files.\")\n\n  let no_automatic_syntax =\n    create \"no_automatic_syntax\" alpha\n      (fun () ->\n         s_ \"Disable the automatic inclusion of -syntax camlp4o for packages \\\n             that matches the internal heuristic (if a dependency ends with \\\n             a .syntax or is a well known syntax).\")\n\n  let findlib_directory =\n    create \"findlib_directory\" beta\n      (fun () ->\n         s_ \"Allow to install findlib libraries in sub-directories of the target \\\n            findlib directory.\")\n\n  let findlib_extra_files =\n    create \"findlib_extra_files\" beta\n      (fun () ->\n         s_ \"Allow to install extra files for findlib libraries.\")\n\n  let source_patterns =\n    create \"source_patterns\" alpha\n      (fun () ->\n         s_ \"Customize mapping between module name and source file.\")\nend\n\nmodule OASISSection = struct\n(* # 22 \"src/oasis/OASISSection.ml\" *)\n\n\n  open OASISTypes\n\n\n  let section_kind_common =\n    function\n      | Library (cs, _, _) ->\n        `Library, cs\n      | Object (cs, _, _) ->\n        `Object, cs\n      | Executable (cs, _, _) ->\n        `Executable, cs\n      | Flag (cs, _) ->\n        `Flag, cs\n      | SrcRepo (cs, _) ->\n        `SrcRepo, cs\n      | Test (cs, _) ->\n        `Test, cs\n      | Doc (cs, _) ->\n        `Doc, cs\n\n\n  let section_common sct =\n    snd (section_kind_common sct)\n\n\n  let section_common_set cs =\n    function\n      | Library (_, bs, lib)     -> Library (cs, bs, lib)\n      | Object (_, bs, obj)      -> Object (cs, bs, obj)\n      | Executable (_, bs, exec) -> Executable (cs, bs, exec)\n      | Flag (_, flg)            -> Flag (cs, flg)\n      | SrcRepo (_, src_repo)    -> SrcRepo (cs, src_repo)\n      | Test (_, tst)            -> Test (cs, tst)\n      | Doc (_, doc)             -> Doc (cs, doc)\n\n\n  (** Key used to identify section\n  *)\n  let section_id sct =\n    let k, cs =\n      section_kind_common sct\n    in\n    k, cs.cs_name\n\n\n  let string_of_section_kind =\n    function\n      | `Library    -> \"library\"\n      | `Object     -> \"object\"\n      | `Executable -> \"executable\"\n      | `Flag       -> \"flag\"\n      | `SrcRepo    -> \"src repository\"\n      | `Test       -> \"test\"\n      | `Doc        -> \"doc\"\n\n\n  let string_of_section sct =\n    let k, nm = section_id sct in\n    (string_of_section_kind k)^\" \"^nm\n\n\n  let section_find id scts =\n    List.find\n      (fun sct -> id = section_id sct)\n      scts\n\n\n  module CSection =\n  struct\n    type t = section\n\n    let id = section_id\n\n    let compare t1 t2 =\n      compare (id t1) (id t2)\n\n    let equal t1 t2 =\n      (id t1) = (id t2)\n\n    let hash t =\n      Hashtbl.hash (id t)\n  end\n\n\n  module MapSection = Map.Make(CSection)\n  module SetSection = Set.Make(CSection)\n\n\nend\n\nmodule OASISBuildSection = struct\n(* # 22 \"src/oasis/OASISBuildSection.ml\" *)\n\n  open OASISTypes\n\n  (* Look for a module file, considering capitalization or not. *)\n  let find_module source_file_exists bs modul =\n    let possible_lst =\n      OASISSourcePatterns.all_possible_files\n        (bs.bs_interface_patterns @ bs.bs_implementation_patterns)\n        ~path:bs.bs_path\n        ~modul\n    in\n    match List.filter source_file_exists possible_lst with\n    | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst)\n    | [] ->\n      let open OASISUtils in\n      let _, rev_lst =\n        List.fold_left\n          (fun (set, acc) fn ->\n             let base_fn = OASISUnixPath.chop_extension fn in\n             if SetString.mem base_fn set then\n               set, acc\n             else\n               SetString.add base_fn set, base_fn :: acc)\n          (SetString.empty, []) possible_lst\n      in\n      `No_sources (List.rev rev_lst)\n\n\nend\n\nmodule OASISExecutable = struct\n(* # 22 \"src/oasis/OASISExecutable.ml\" *)\n\n\n  open OASISTypes\n\n\n  let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =\n    let dir =\n      OASISUnixPath.concat\n        bs.bs_path\n        (OASISUnixPath.dirname exec.exec_main_is)\n    in\n    let is_native_exec =\n      match bs.bs_compiled_object with\n        | Native -> true\n        | Best -> is_native ()\n        | Byte -> false\n    in\n\n    OASISUnixPath.concat\n      dir\n      (cs.cs_name^(suffix_program ())),\n\n    if not is_native_exec &&\n       not exec.exec_custom &&\n       bs.bs_c_sources <> [] then\n      Some (dir^\"/dll\"^cs.cs_name^\"_stubs\"^(ext_dll ()))\n    else\n      None\n\n\nend\n\nmodule OASISLibrary = struct\n(* # 22 \"src/oasis/OASISLibrary.ml\" *)\n\n\n  open OASISTypes\n  open OASISGettext\n\n  let find_module ~ctxt source_file_exists cs bs modul =\n    match OASISBuildSection.find_module source_file_exists bs modul with\n    | `Sources _ as res -> res\n    | `No_sources _ as res ->\n      OASISMessage.warning\n        ~ctxt\n        (f_ \"Cannot find source file matching module '%s' in library %s.\")\n        modul cs.cs_name;\n      OASISMessage.warning\n        ~ctxt\n        (f_ \"Use InterfacePatterns or ImplementationPatterns to define \\\n             this file with feature %S.\")\n        (OASISFeatures.source_patterns.OASISFeatures.name);\n      res\n\n  let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =\n    List.fold_left\n      (fun acc modul ->\n         match find_module ~ctxt source_file_exists cs bs modul with\n         | `Sources (base_fn, lst) -> (base_fn, lst) :: acc\n         | `No_sources _ -> acc)\n      []\n      (lib.lib_modules @ lib.lib_internal_modules)\n\n\n  let generated_unix_files\n      ~ctxt\n      ~is_native\n      ~has_native_dynlink\n      ~ext_lib\n      ~ext_dll\n      ~source_file_exists\n      (cs, bs, lib) =\n\n    let find_modules lst ext =\n      let find_module modul =\n        match find_module ~ctxt source_file_exists cs bs modul with\n        | `Sources (_, [fn]) when ext <> \"cmi\"\n                                     && Filename.check_suffix fn \".mli\" ->\n          None (* No implementation files for pure interface. *)\n        | `Sources (base_fn, _) -> Some [base_fn]\n        | `No_sources lst -> Some lst\n      in\n      List.fold_left\n        (fun acc nm ->\n           match find_module nm with\n           | None -> acc\n           | Some base_fns ->\n             List.map (fun base_fn -> base_fn ^\".\"^ext) base_fns :: acc)\n        []\n        lst\n    in\n\n    (* The .cmx that be compiled along *)\n    let cmxs =\n      let should_be_built =\n        match bs.bs_compiled_object with\n        | Native -> true\n        | Best -> is_native\n        | Byte -> false\n      in\n      if should_be_built then\n        if lib.lib_pack then\n          find_modules\n            [cs.cs_name]\n            \"cmx\"\n        else\n          find_modules\n            (lib.lib_modules @ lib.lib_internal_modules)\n            \"cmx\"\n      else\n        []\n    in\n\n    let acc_nopath =\n      []\n    in\n\n    (* The headers and annot/cmt files that should be compiled along *)\n    let headers =\n      let sufx =\n        if lib.lib_pack\n        then [\".cmti\"; \".cmt\"; \".annot\"]\n        else [\".cmi\"; \".cmti\"; \".cmt\"; \".annot\"]\n      in\n      List.map\n        (List.fold_left\n           (fun accu s ->\n              let dot = String.rindex s '.' in\n              let base = String.sub s 0 dot in\n              List.map ((^) base) sufx @ accu)\n           [])\n        (find_modules lib.lib_modules \"cmi\")\n    in\n\n    (* Compute what libraries should be built *)\n    let acc_nopath =\n      (* Add the packed header file if required *)\n      let add_pack_header acc =\n        if lib.lib_pack then\n          [cs.cs_name^\".cmi\"; cs.cs_name^\".cmti\"; cs.cs_name^\".cmt\"] :: acc\n        else\n          acc\n      in\n      let byte acc =\n        add_pack_header ([cs.cs_name^\".cma\"] :: acc)\n      in\n      let native acc =\n        let acc =\n          add_pack_header\n            (if has_native_dynlink then\n               [cs.cs_name^\".cmxs\"] :: acc\n             else acc)\n        in\n        [cs.cs_name^\".cmxa\"] :: [cs.cs_name^ext_lib] :: acc\n      in\n      match bs.bs_compiled_object with\n      | Native -> byte (native acc_nopath)\n      | Best when is_native -> byte (native acc_nopath)\n      | Byte | Best -> byte acc_nopath\n    in\n\n    (* Add C library to be built *)\n    let acc_nopath =\n      if bs.bs_c_sources <> [] then begin\n        [\"lib\"^cs.cs_name^\"_stubs\"^ext_lib]\n        ::\n        if has_native_dynlink then\n          [\"dll\"^cs.cs_name^\"_stubs\"^ext_dll] :: acc_nopath\n        else\n          acc_nopath\n      end else begin\n        acc_nopath\n      end\n    in\n\n    (* All the files generated *)\n    List.rev_append\n      (List.rev_map\n         (List.rev_map\n            (OASISUnixPath.concat bs.bs_path))\n         acc_nopath)\n      (headers @ cmxs)\n\n\nend\n\nmodule OASISObject = struct\n(* # 22 \"src/oasis/OASISObject.ml\" *)\n\n\n  open OASISTypes\n  open OASISGettext\n\n\n  let find_module ~ctxt source_file_exists cs bs modul =\n    match OASISBuildSection.find_module source_file_exists bs modul with\n    | `Sources _ as res -> res\n    | `No_sources _ as res ->\n      OASISMessage.warning\n        ~ctxt\n        (f_ \"Cannot find source file matching module '%s' in object %s.\")\n        modul cs.cs_name;\n      OASISMessage.warning\n        ~ctxt\n        (f_ \"Use InterfacePatterns or ImplementationPatterns to define \\\n             this file with feature %S.\")\n        (OASISFeatures.source_patterns.OASISFeatures.name);\n      res\n\n  let source_unix_files ~ctxt (cs, bs, obj) source_file_exists =\n    List.fold_left\n      (fun acc modul ->\n         match find_module ~ctxt source_file_exists cs bs modul with\n         | `Sources (base_fn, lst) -> (base_fn, lst) :: acc\n         | `No_sources _ -> acc)\n      []\n      obj.obj_modules\n\n\n  let generated_unix_files\n      ~ctxt\n      ~is_native\n      ~source_file_exists\n      (cs, bs, obj) =\n\n    let find_module ext modul =\n      match find_module ~ctxt source_file_exists cs bs modul with\n      | `Sources (base_fn, _) -> [base_fn ^ ext]\n      | `No_sources lst -> lst\n    in\n\n    let header, byte, native, c_object, f =\n      match obj.obj_modules with\n        | [ m ] -> (find_module \".cmi\" m,\n            find_module \".cmo\" m,\n            find_module \".cmx\" m,\n            find_module \".o\" m,\n            fun x -> x)\n        | _ -> ([cs.cs_name ^ \".cmi\"],\n            [cs.cs_name ^ \".cmo\"],\n            [cs.cs_name ^ \".cmx\"],\n            [cs.cs_name ^ \".o\"],\n            OASISUnixPath.concat bs.bs_path)\n    in\n    List.map (List.map f) (\n      match bs.bs_compiled_object with\n        | Native ->\n          native :: c_object :: byte :: header :: []\n        | Best when is_native ->\n          native :: c_object :: byte :: header :: []\n        | Byte | Best ->\n          byte :: header :: [])\n\n\nend\n\nmodule OASISFindlib = struct\n(* # 22 \"src/oasis/OASISFindlib.ml\" *)\n\n\n  open OASISTypes\n  open OASISUtils\n  open OASISGettext\n\n\n  type library_name = name\n  type findlib_part_name = name\n  type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t\n\n\n  exception InternalLibraryNotFound of library_name\n  exception FindlibPackageNotFound of findlib_name\n\n\n  type group_t =\n    | Container of findlib_name * group_t list\n    | Package of (findlib_name *\n                  common_section *\n                  build_section *\n                  [`Library of library | `Object of object_] *\n                  unix_dirname option *\n                  group_t list)\n\n\n  type data = common_section *\n      build_section *\n      [`Library of library | `Object of object_]\n  type tree =\n    | Node of (data option) * (tree MapString.t)\n    | Leaf of data\n\n\n  let findlib_mapping pkg =\n    (* Map from library name to either full findlib name or parts + parent. *)\n    let fndlb_parts_of_lib_name =\n      let fndlb_parts cs lib =\n        let name =\n          match lib.lib_findlib_name with\n            | Some nm -> nm\n            | None -> cs.cs_name\n        in\n        let name =\n          String.concat \".\" (lib.lib_findlib_containers @ [name])\n        in\n        name\n      in\n      List.fold_left\n        (fun mp ->\n           function\n             | Library (cs, _, lib) ->\n               begin\n                 let lib_name = cs.cs_name in\n                 let fndlb_parts = fndlb_parts cs lib in\n                 if MapString.mem lib_name mp then\n                   failwithf\n                     (f_ \"The library name '%s' is used more than once.\")\n                     lib_name;\n                 match lib.lib_findlib_parent with\n                   | Some lib_name_parent ->\n                     MapString.add\n                       lib_name\n                       (`Unsolved (lib_name_parent, fndlb_parts))\n                       mp\n                   | None ->\n                     MapString.add\n                       lib_name\n                       (`Solved fndlb_parts)\n                       mp\n               end\n\n             | Object (cs, _, obj) ->\n               begin\n                 let obj_name = cs.cs_name in\n                 if MapString.mem obj_name mp then\n                   failwithf\n                     (f_ \"The object name '%s' is used more than once.\")\n                     obj_name;\n                 let findlib_full_name = match obj.obj_findlib_fullname with\n                   | Some ns -> String.concat \".\" ns\n                   | None -> obj_name\n                 in\n                 MapString.add\n                   obj_name\n                   (`Solved findlib_full_name)\n                   mp\n               end\n\n             | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->\n               mp)\n        MapString.empty\n        pkg.sections\n    in\n\n    (* Solve the above graph to be only library name to full findlib name. *)\n    let fndlb_name_of_lib_name =\n      let rec solve visited mp lib_name lib_name_child =\n        if SetString.mem lib_name visited then\n          failwithf\n            (f_ \"Library '%s' is involved in a cycle \\\n                 with regard to findlib naming.\")\n            lib_name;\n        let visited = SetString.add lib_name visited in\n        try\n          match MapString.find lib_name mp with\n            | `Solved fndlb_nm ->\n              fndlb_nm, mp\n            | `Unsolved (lib_nm_parent, post_fndlb_nm) ->\n              let pre_fndlb_nm, mp =\n                solve visited mp lib_nm_parent lib_name\n              in\n              let fndlb_nm = pre_fndlb_nm^\".\"^post_fndlb_nm in\n              fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp\n        with Not_found ->\n          failwithf\n            (f_ \"Library '%s', which is defined as the findlib parent of \\\n                 library '%s', doesn't exist.\")\n            lib_name lib_name_child\n      in\n      let mp =\n        MapString.fold\n          (fun lib_name status mp ->\n             match status with\n               | `Solved _ ->\n                 (* Solved initialy, no need to go further *)\n                 mp\n               | `Unsolved _ ->\n                 let _, mp = solve SetString.empty mp lib_name \"<none>\" in\n                 mp)\n          fndlb_parts_of_lib_name\n          fndlb_parts_of_lib_name\n      in\n      MapString.map\n        (function\n          | `Solved fndlb_nm -> fndlb_nm\n          | `Unsolved _ -> assert false)\n        mp\n    in\n\n    (* Convert an internal library name to a findlib name. *)\n    let findlib_name_of_library_name lib_nm =\n      try\n        MapString.find lib_nm fndlb_name_of_lib_name\n      with Not_found ->\n        raise (InternalLibraryNotFound lib_nm)\n    in\n\n    (* Add a library to the tree.\n    *)\n    let add sct mp =\n      let fndlb_fullname =\n        let cs, _, _ = sct in\n        let lib_name = cs.cs_name in\n        findlib_name_of_library_name lib_name\n      in\n      let rec add_children nm_lst (children: tree MapString.t) =\n        match nm_lst with\n          | (hd :: tl) ->\n            begin\n              let node =\n                try\n                  add_node tl (MapString.find hd children)\n                with Not_found ->\n                  (* New node *)\n                  new_node tl\n              in\n              MapString.add hd node children\n            end\n          | [] ->\n            (* Should not have a nameless library. *)\n            assert false\n      and add_node tl node =\n        if tl = [] then\n          begin\n            match node with\n              | Node (None, children) ->\n                Node (Some sct, children)\n              | Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->\n                (* TODO: allow to merge Package, i.e.\n                 * archive(byte) = \"foo.cma foo_init.cmo\"\n                *)\n                let cs, _, _ = sct in\n                failwithf\n                  (f_ \"Library '%s' and '%s' have the same findlib name '%s'\")\n                  cs.cs_name cs'.cs_name fndlb_fullname\n          end\n        else\n          begin\n            match node with\n              | Leaf data ->\n                Node (Some data, add_children tl MapString.empty)\n              | Node (data_opt, children) ->\n                Node (data_opt, add_children tl children)\n          end\n      and new_node =\n        function\n          | [] ->\n            Leaf sct\n          | hd :: tl ->\n            Node (None, MapString.add hd (new_node tl) MapString.empty)\n      in\n      add_children (OASISString.nsplit fndlb_fullname '.') mp\n    in\n\n    let unix_directory dn lib =\n      let directory =\n        match lib with\n        | `Library lib -> lib.lib_findlib_directory\n        | `Object obj -> obj.obj_findlib_directory\n      in\n      match dn, directory with\n      | None, None -> None\n      | None, Some dn | Some dn, None -> Some dn\n      | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2)\n    in\n\n    let rec group_of_tree dn mp =\n      MapString.fold\n        (fun nm node acc ->\n           let cur =\n             match node with\n             | Node (Some (cs, bs, lib), children) ->\n               let current_dn = unix_directory dn lib in\n               Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children)\n             | Node (None, children) ->\n               Container (nm, group_of_tree dn children)\n             | Leaf (cs, bs, lib) ->\n               let current_dn = unix_directory dn lib in\n               Package (nm, cs, bs, lib, current_dn, [])\n           in\n           cur :: acc)\n        mp []\n    in\n\n    let group_mp =\n      List.fold_left\n        (fun mp ->\n           function\n             | Library (cs, bs, lib) ->\n               add (cs, bs, `Library lib) mp\n             | Object (cs, bs, obj) ->\n               add (cs, bs, `Object obj) mp\n             | _ ->\n               mp)\n        MapString.empty\n        pkg.sections\n    in\n\n    let groups = group_of_tree None group_mp in\n\n    let library_name_of_findlib_name =\n      lazy begin\n        (* Revert findlib_name_of_library_name. *)\n        MapString.fold\n          (fun k v mp -> MapString.add v k mp)\n          fndlb_name_of_lib_name\n          MapString.empty\n      end\n    in\n    let library_name_of_findlib_name fndlb_nm =\n      try\n        MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name)\n      with Not_found ->\n        raise (FindlibPackageNotFound fndlb_nm)\n    in\n\n    groups,\n    findlib_name_of_library_name,\n    library_name_of_findlib_name\n\n\n  let findlib_of_group =\n    function\n      | Container (fndlb_nm, _)\n      | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm\n\n\n  let root_of_group grp =\n    let rec root_lib_aux =\n      (* We do a DFS in the group. *)\n      function\n        | Container (_, children) ->\n          List.fold_left\n            (fun res grp ->\n               if res = None then\n                 root_lib_aux grp\n               else\n                 res)\n            None\n            children\n        | Package (_, cs, bs, lib, _, _) ->\n          Some (cs, bs, lib)\n    in\n    match root_lib_aux grp with\n      | Some res ->\n        res\n      | None ->\n        failwithf\n          (f_ \"Unable to determine root library of findlib library '%s'\")\n          (findlib_of_group grp)\n\n\nend\n\nmodule OASISFlag = struct\n(* # 22 \"src/oasis/OASISFlag.ml\" *)\n\n\nend\n\nmodule OASISPackage = struct\n(* # 22 \"src/oasis/OASISPackage.ml\" *)\n\n\nend\n\nmodule OASISSourceRepository = struct\n(* # 22 \"src/oasis/OASISSourceRepository.ml\" *)\n\n\nend\n\nmodule OASISTest = struct\n(* # 22 \"src/oasis/OASISTest.ml\" *)\n\n\nend\n\nmodule OASISDocument = struct\n(* # 22 \"src/oasis/OASISDocument.ml\" *)\n\n\nend\n\nmodule OASISExec = struct\n(* # 22 \"src/oasis/OASISExec.ml\" *)\n\n\n  open OASISGettext\n  open OASISUtils\n  open OASISMessage\n\n\n  (* TODO: I don't like this quote, it is there because $(rm) foo expands to\n   * 'rm -f' foo...\n  *)\n  let run ~ctxt ?f_exit_code ?(quote=true) cmd args =\n    let cmd =\n      if quote then\n        if Sys.os_type = \"Win32\" then\n          if String.contains cmd ' ' then\n            (* Double the 1st double quote... win32... sigh *)\n            \"\\\"\"^(Filename.quote cmd)\n          else\n            cmd\n        else\n          Filename.quote cmd\n      else\n        cmd\n    in\n    let cmdline =\n      String.concat \" \" (cmd :: args)\n    in\n    info ~ctxt (f_ \"Running command '%s'\") cmdline;\n    match f_exit_code, Sys.command cmdline with\n      | None, 0 -> ()\n      | None, i ->\n        failwithf\n          (f_ \"Command '%s' terminated with error code %d\")\n          cmdline i\n      | Some f, i ->\n        f i\n\n\n  let run_read_output ~ctxt ?f_exit_code cmd args =\n    let fn =\n      Filename.temp_file \"oasis-\" \".txt\"\n    in\n    try\n      begin\n        let () =\n          run ~ctxt ?f_exit_code cmd (args @ [\">\"; Filename.quote fn])\n        in\n        let chn =\n          open_in fn\n        in\n        let routput =\n          ref []\n        in\n        begin\n          try\n            while true do\n              routput := (input_line chn) :: !routput\n            done\n          with End_of_file ->\n            ()\n        end;\n        close_in chn;\n        Sys.remove fn;\n        List.rev !routput\n      end\n    with e ->\n      (try Sys.remove fn with _ -> ());\n      raise e\n\n\n  let run_read_one_line ~ctxt ?f_exit_code cmd args =\n    match run_read_output ~ctxt ?f_exit_code cmd args with\n      | [fst] ->\n        fst\n      | lst ->\n        failwithf\n          (f_ \"Command return unexpected output %S\")\n          (String.concat \"\\n\" lst)\nend\n\nmodule OASISFileUtil = struct\n(* # 22 \"src/oasis/OASISFileUtil.ml\" *)\n\n\n  open OASISGettext\n\n\n  let file_exists_case fn =\n    let dirname = Filename.dirname fn in\n    let basename = Filename.basename fn in\n    if Sys.file_exists dirname then\n      if basename = Filename.current_dir_name then\n        true\n      else\n        List.mem\n          basename\n          (Array.to_list (Sys.readdir dirname))\n    else\n      false\n\n\n  let find_file ?(case_sensitive=true) paths exts =\n\n    (* Cardinal product of two list *)\n    let ( * ) lst1 lst2 =\n      List.flatten\n        (List.map\n           (fun a ->\n              List.map\n                (fun b -> a, b)\n                lst2)\n           lst1)\n    in\n\n    let rec combined_paths lst =\n      match lst with\n        | p1 :: p2 :: tl ->\n          let acc =\n            (List.map\n               (fun (a, b) -> Filename.concat a b)\n               (p1 * p2))\n          in\n          combined_paths (acc :: tl)\n        | [e] ->\n          e\n        | [] ->\n          []\n    in\n\n    let alternatives =\n      List.map\n        (fun (p, e) ->\n           if String.length e > 0 && e.[0] <> '.' then\n             p ^ \".\" ^ e\n           else\n             p ^ e)\n        ((combined_paths paths) * exts)\n    in\n    List.find (fun file ->\n      (if case_sensitive then\n         file_exists_case file\n       else\n         Sys.file_exists file)\n      && not (Sys.is_directory file)\n    ) alternatives\n\n\n  let which ~ctxt prg =\n    let path_sep =\n      match Sys.os_type with\n        | \"Win32\" ->\n          ';'\n        | _ ->\n          ':'\n    in\n    let path_lst = OASISString.nsplit (Sys.getenv \"PATH\") path_sep in\n    let exec_ext =\n      match Sys.os_type with\n        | \"Win32\" ->\n          \"\" :: (OASISString.nsplit (Sys.getenv \"PATHEXT\") path_sep)\n        | _ ->\n          [\"\"]\n    in\n    find_file ~case_sensitive:false [path_lst; [prg]] exec_ext\n\n\n  (**/**)\n  let rec fix_dir dn =\n    (* Windows hack because Sys.file_exists \"src\\\\\" = false when\n     * Sys.file_exists \"src\" = true\n    *)\n    let ln =\n      String.length dn\n    in\n    if Sys.os_type = \"Win32\" && ln > 0 && dn.[ln - 1] = '\\\\' then\n      fix_dir (String.sub dn 0 (ln - 1))\n    else\n      dn\n\n\n  let q = Filename.quote\n  (**/**)\n\n\n  let cp ~ctxt ?(recurse=false) src tgt =\n    if recurse then\n      match Sys.os_type with\n        | \"Win32\" ->\n          OASISExec.run ~ctxt\n            \"xcopy\" [q src; q tgt; \"/E\"]\n        | _ ->\n          OASISExec.run ~ctxt\n            \"cp\" [\"-r\"; q src; q tgt]\n    else\n      OASISExec.run ~ctxt\n        (match Sys.os_type with\n          | \"Win32\" -> \"copy\"\n          | _ -> \"cp\")\n        [q src; q tgt]\n\n\n  let mkdir ~ctxt tgt =\n    OASISExec.run ~ctxt\n      (match Sys.os_type with\n        | \"Win32\" -> \"md\"\n        | _ -> \"mkdir\")\n      [q tgt]\n\n\n  let rec mkdir_parent ~ctxt f tgt =\n    let tgt =\n      fix_dir tgt\n    in\n    if Sys.file_exists tgt then\n      begin\n        if not (Sys.is_directory tgt) then\n          OASISUtils.failwithf\n            (f_ \"Cannot create directory '%s', a file of the same name already \\\n                 exists\")\n            tgt\n      end\n    else\n      begin\n        mkdir_parent ~ctxt f (Filename.dirname tgt);\n        if not (Sys.file_exists tgt) then\n          begin\n            f tgt;\n            mkdir ~ctxt tgt\n          end\n      end\n\n\n  let rmdir ~ctxt tgt =\n    if Sys.readdir tgt = [||] then begin\n      match Sys.os_type with\n        | \"Win32\" ->\n          OASISExec.run ~ctxt \"rd\" [q tgt]\n        | _ ->\n          OASISExec.run ~ctxt \"rm\" [\"-r\"; q tgt]\n    end else begin\n      OASISMessage.error ~ctxt\n        (f_ \"Cannot remove directory '%s': not empty.\")\n        tgt\n    end\n\n\n  let glob ~ctxt fn =\n    let basename =\n      Filename.basename fn\n    in\n    if String.length basename >= 2 &&\n       basename.[0] = '*' &&\n       basename.[1] = '.' then\n      begin\n        let ext_len =\n          (String.length basename) - 2\n        in\n        let ext =\n          String.sub basename 2 ext_len\n        in\n        let dirname =\n          Filename.dirname fn\n        in\n        Array.fold_left\n          (fun acc fn ->\n             try\n               let fn_ext =\n                 String.sub\n                   fn\n                   ((String.length fn) - ext_len)\n                   ext_len\n               in\n               if fn_ext = ext then\n                 (Filename.concat dirname fn) :: acc\n               else\n                 acc\n             with Invalid_argument _ ->\n               acc)\n          []\n          (Sys.readdir dirname)\n      end\n    else\n      begin\n        if file_exists_case fn then\n          [fn]\n        else\n          []\n      end\nend\n\n\n# 3159 \"setup.ml\"\nmodule BaseEnvLight = struct\n(* # 22 \"src/base/BaseEnvLight.ml\" *)\n\n\n  module MapString = Map.Make(String)\n\n\n  type t = string MapString.t\n\n\n  let default_filename = Filename.concat (Sys.getcwd ()) \"setup.data\"\n\n\n  let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =\n    let line = ref 1 in\n    let lexer st =\n      let st_line =\n        Stream.from\n          (fun _ ->\n             try\n               match Stream.next st with\n               | '\\n' -> incr line; Some '\\n'\n               | c -> Some c\n             with Stream.Failure -> None)\n      in\n      Genlex.make_lexer [\"=\"] st_line\n    in\n    let rec read_file lxr mp =\n      match Stream.npeek 3 lxr with\n      | [Genlex.Ident nm; Genlex.Kwd \"=\"; Genlex.String value] ->\n        Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;\n        read_file lxr (MapString.add nm value mp)\n      | [] -> mp\n      | _ ->\n        failwith\n          (Printf.sprintf \"Malformed data file '%s' line %d\" filename !line)\n    in\n    match stream with\n    | Some st -> read_file (lexer st) MapString.empty\n    | None ->\n      if Sys.file_exists filename then begin\n        let chn = open_in_bin filename in\n        let st = Stream.of_channel chn in\n        try\n          let mp = read_file (lexer st) MapString.empty in\n          close_in chn; mp\n        with e ->\n          close_in chn; raise e\n      end else if allow_empty then begin\n        MapString.empty\n      end else begin\n        failwith\n          (Printf.sprintf\n             \"Unable to load environment, the file '%s' doesn't exist.\"\n             filename)\n      end\n\n  let rec var_expand str env =\n    let buff = Buffer.create ((String.length str) * 2) in\n    Buffer.add_substitute\n      buff\n      (fun var ->\n         try\n           var_expand (MapString.find var env) env\n         with Not_found ->\n           failwith\n             (Printf.sprintf\n                \"No variable %s defined when trying to expand %S.\"\n                var\n                str))\n      str;\n    Buffer.contents buff\n\n\n  let var_get name env = var_expand (MapString.find name env) env\n  let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst\nend\n\n\n# 3239 \"setup.ml\"\nmodule BaseContext = struct\n(* # 22 \"src/base/BaseContext.ml\" *)\n\n  (* TODO: get rid of this module. *)\n  open OASISContext\n\n\n  let args () = fst (fspecs ())\n\n\n  let default = default\n\nend\n\nmodule BaseMessage = struct\n(* # 22 \"src/base/BaseMessage.ml\" *)\n\n\n  (** Message to user, overrid for Base\n      @author Sylvain Le Gall\n  *)\n  open OASISMessage\n  open BaseContext\n\n\n  let debug fmt   = debug ~ctxt:!default fmt\n\n\n  let info fmt    = info ~ctxt:!default fmt\n\n\n  let warning fmt = warning ~ctxt:!default fmt\n\n\n  let error fmt = error ~ctxt:!default fmt\n\nend\n\nmodule BaseEnv = struct\n(* # 22 \"src/base/BaseEnv.ml\" *)\n\n  open OASISGettext\n  open OASISUtils\n  open OASISContext\n  open PropList\n\n\n  module MapString = BaseEnvLight.MapString\n\n\n  type origin_t =\n    | ODefault\n    | OGetEnv\n    | OFileLoad\n    | OCommandLine\n\n\n  type cli_handle_t =\n    | CLINone\n    | CLIAuto\n    | CLIWith\n    | CLIEnable\n    | CLIUser of (Arg.key * Arg.spec * Arg.doc) list\n\n\n  type definition_t =\n    {\n      hide:       bool;\n      dump:       bool;\n      cli:        cli_handle_t;\n      arg_help:   string option;\n      group:      string option;\n    }\n\n\n  let schema = Schema.create \"environment\"\n\n\n  (* Environment data *)\n  let env = Data.create ()\n\n\n  (* Environment data from file *)\n  let env_from_file = ref MapString.empty\n\n\n  (* Lexer for var *)\n  let var_lxr = Genlex.make_lexer []\n\n\n  let rec var_expand str =\n    let buff =\n      Buffer.create ((String.length str) * 2)\n    in\n    Buffer.add_substitute\n      buff\n      (fun var ->\n         try\n           (* TODO: this is a quick hack to allow calling Test.Command\n            * without defining executable name really. I.e. if there is\n            * an exec Executable toto, then $(toto) should be replace\n            * by its real name. It is however useful to have this function\n            * for other variable that depend on the host and should be\n            * written better than that.\n           *)\n           let st =\n             var_lxr (Stream.of_string var)\n           in\n           match Stream.npeek 3 st with\n             | [Genlex.Ident \"utoh\"; Genlex.Ident nm] ->\n               OASISHostPath.of_unix (var_get nm)\n             | [Genlex.Ident \"utoh\"; Genlex.String s] ->\n               OASISHostPath.of_unix s\n             | [Genlex.Ident \"ocaml_escaped\"; Genlex.Ident nm] ->\n               String.escaped (var_get nm)\n             | [Genlex.Ident \"ocaml_escaped\"; Genlex.String s] ->\n               String.escaped s\n             | [Genlex.Ident nm] ->\n               var_get nm\n             | _ ->\n               failwithf\n                 (f_ \"Unknown expression '%s' in variable expansion of %s.\")\n                 var\n                 str\n         with\n           | Unknown_field (_, _) ->\n             failwithf\n               (f_ \"No variable %s defined when trying to expand %S.\")\n               var\n               str\n           | Stream.Error e ->\n             failwithf\n               (f_ \"Syntax error when parsing '%s' when trying to \\\n                    expand %S: %s\")\n               var\n               str\n               e)\n      str;\n    Buffer.contents buff\n\n\n  and var_get name =\n    let vl =\n      try\n        Schema.get schema env name\n      with Unknown_field _ as e ->\n        begin\n          try\n            MapString.find name !env_from_file\n          with Not_found ->\n            raise e\n        end\n    in\n    var_expand vl\n\n\n  let var_choose ?printer ?name lst =\n    OASISExpr.choose\n      ?printer\n      ?name\n      var_get\n      lst\n\n\n  let var_protect vl =\n    let buff =\n      Buffer.create (String.length vl)\n    in\n    String.iter\n      (function\n        | '$' -> Buffer.add_string buff \"\\\\$\"\n        | c   -> Buffer.add_char   buff c)\n      vl;\n    Buffer.contents buff\n\n\n  let var_define\n      ?(hide=false)\n      ?(dump=true)\n      ?short_desc\n      ?(cli=CLINone)\n      ?arg_help\n      ?group\n      name (* TODO: type constraint on the fact that name must be a valid OCaml\n                id *)\n      dflt =\n\n    let default =\n      [\n        OFileLoad, (fun () -> MapString.find name !env_from_file);\n        ODefault,  dflt;\n        OGetEnv,   (fun () -> Sys.getenv name);\n      ]\n    in\n\n    let extra =\n      {\n        hide     = hide;\n        dump     = dump;\n        cli      = cli;\n        arg_help = arg_help;\n        group    = group;\n      }\n    in\n\n    (* Try to find a value that can be defined\n    *)\n    let var_get_low lst =\n      let errors, res =\n        List.fold_left\n          (fun (errors, res) (_, v) ->\n             if res = None then\n               begin\n                 try\n                   errors, Some (v ())\n                 with\n                   | Not_found ->\n                     errors, res\n                   | Failure rsn ->\n                     (rsn :: errors), res\n                   | e ->\n                     (Printexc.to_string e) :: errors, res\n               end\n             else\n               errors, res)\n          ([], None)\n          (List.sort\n             (fun (o1, _) (o2, _) ->\n                Pervasives.compare o2 o1)\n             lst)\n      in\n      match res, errors with\n        | Some v, _ ->\n          v\n        | None, [] ->\n          raise (Not_set (name, None))\n        | None, lst ->\n          raise (Not_set (name, Some (String.concat (s_ \", \") lst)))\n    in\n\n    let help =\n      match short_desc with\n        | Some fs -> Some fs\n        | None -> None\n    in\n\n    let var_get_lst =\n      FieldRO.create\n        ~schema\n        ~name\n        ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])\n        ~print:var_get_low\n        ~default\n        ~update:(fun ?context:_ x old_x -> x @ old_x)\n        ?help\n        extra\n    in\n\n    fun () ->\n      var_expand (var_get_low (var_get_lst env))\n\n\n  let var_redefine\n      ?hide\n      ?dump\n      ?short_desc\n      ?cli\n      ?arg_help\n      ?group\n      name\n      dflt =\n    if Schema.mem schema name then\n      begin\n        (* TODO: look suspsicious, we want to memorize dflt not dflt () *)\n        Schema.set schema env ~context:ODefault name (dflt ());\n        fun () -> var_get name\n      end\n    else\n      begin\n        var_define\n          ?hide\n          ?dump\n          ?short_desc\n          ?cli\n          ?arg_help\n          ?group\n          name\n          dflt\n      end\n\n\n  let var_ignore (_: unit -> string) = ()\n\n\n  let print_hidden =\n    var_define\n      ~hide:true\n      ~dump:false\n      ~cli:CLIAuto\n      ~arg_help:\"Print even non-printable variable. (debug)\"\n      \"print_hidden\"\n      (fun () -> \"false\")\n\n\n  let var_all () =\n    List.rev\n      (Schema.fold\n         (fun acc nm def _ ->\n            if not def.hide || bool_of_string (print_hidden ()) then\n              nm :: acc\n            else\n              acc)\n         []\n         schema)\n\n\n  let default_filename = in_srcdir \"setup.data\"\n\n\n  let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () =\n    let open OASISFileSystem in\n    env_from_file :=\n      let repr_filename = ctxt.srcfs#string_of_filename filename in\n      if ctxt.srcfs#file_exists filename then begin\n        let buf = Buffer.create 13 in\n        defer_close\n          (ctxt.srcfs#open_in ~mode:binary_in filename)\n          (read_all buf);\n        defer_close\n          (ctxt.srcfs#open_in ~mode:binary_in filename)\n          (fun rdr ->\n             OASISMessage.info ~ctxt \"Loading environment from %S.\" repr_filename;\n             BaseEnvLight.load ~allow_empty\n               ~filename:(repr_filename)\n               ~stream:(stream_of_reader rdr)\n               ())\n      end else if allow_empty then begin\n        BaseEnvLight.MapString.empty\n      end else begin\n        failwith\n          (Printf.sprintf\n             (f_ \"Unable to load environment, the file '%s' doesn't exist.\")\n             repr_filename)\n      end\n\n\n  let unload () =\n    env_from_file := MapString.empty;\n    Data.clear env\n\n\n  let dump ~ctxt ?(filename=default_filename) () =\n    let open OASISFileSystem in\n    defer_close\n      (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename)\n      (fun wrtr ->\n         let buf = Buffer.create 63 in\n         let output nm value =\n           Buffer.add_string buf (Printf.sprintf \"%s=%S\\n\" nm value)\n         in\n         let mp_todo =\n           (* Dump data from schema *)\n           Schema.fold\n             (fun mp_todo nm def _ ->\n                if def.dump then begin\n                  try\n                    output nm (Schema.get schema env nm)\n                  with Not_set _ ->\n                    ()\n                end;\n                MapString.remove nm mp_todo)\n             !env_from_file\n             schema\n         in\n         (* Dump data defined outside of schema *)\n         MapString.iter output mp_todo;\n         wrtr#output buf)\n\n  let print () =\n    let printable_vars =\n      Schema.fold\n        (fun acc nm def short_descr_opt ->\n           if not def.hide || bool_of_string (print_hidden ()) then\n             begin\n               try\n                 let value = Schema.get schema env nm in\n                 let txt =\n                   match short_descr_opt with\n                     | Some s -> s ()\n                     | None -> nm\n                 in\n                 (txt, value) :: acc\n               with Not_set _ ->\n                 acc\n             end\n           else\n             acc)\n        []\n        schema\n    in\n    let max_length =\n      List.fold_left max 0\n        (List.rev_map String.length\n           (List.rev_map fst printable_vars))\n    in\n    let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in\n    Printf.printf \"\\nConfiguration:\\n\";\n    List.iter\n      (fun (name, value) ->\n         Printf.printf \"%s: %s\" name (dot_pad name);\n         if value = \"\" then\n           Printf.printf \"\\n\"\n         else\n           Printf.printf \" %s\\n\" value)\n      (List.rev printable_vars);\n    Printf.printf \"\\n%!\"\n\n\n  let args () =\n    let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in\n    [\n      \"--override\",\n      Arg.Tuple\n        (\n          let rvr = ref \"\"\n          in\n          let rvl = ref \"\"\n          in\n          [\n            Arg.Set_string rvr;\n            Arg.Set_string rvl;\n            Arg.Unit\n              (fun () ->\n                 Schema.set\n                   schema\n                   env\n                   ~context:OCommandLine\n                   !rvr\n                   !rvl)\n          ]\n        ),\n      \"var+val  Override any configuration variable.\";\n\n    ]\n    @\n      List.flatten\n        (Schema.fold\n           (fun acc name def short_descr_opt ->\n              let var_set s =\n                Schema.set\n                  schema\n                  env\n                  ~context:OCommandLine\n                  name\n                  s\n              in\n\n              let arg_name =\n                OASISUtils.varname_of_string ~hyphen:'-' name\n              in\n\n              let hlp =\n                match short_descr_opt with\n                  | Some txt -> txt ()\n                  | None -> \"\"\n              in\n\n              let arg_hlp =\n                match def.arg_help with\n                  | Some s -> s\n                  | None   -> \"str\"\n              in\n\n              let default_value =\n                try\n                  Printf.sprintf\n                    (f_ \" [%s]\")\n                    (Schema.get\n                       schema\n                       env\n                       name)\n                with Not_set _ ->\n                  \"\"\n              in\n\n              let args =\n                match def.cli with\n                  | CLINone ->\n                    []\n                  | CLIAuto ->\n                    [\n                      arg_concat \"--\" arg_name,\n                      Arg.String var_set,\n                      Printf.sprintf (f_ \"%s %s%s\") arg_hlp hlp default_value\n                    ]\n                  | CLIWith ->\n                    [\n                      arg_concat \"--with-\" arg_name,\n                      Arg.String var_set,\n                      Printf.sprintf (f_ \"%s %s%s\") arg_hlp hlp default_value\n                    ]\n                  | CLIEnable ->\n                    let dflt =\n                      if default_value = \" [true]\" then\n                        s_ \" [default: enabled]\"\n                      else\n                        s_ \" [default: disabled]\"\n                    in\n                    [\n                      arg_concat \"--enable-\" arg_name,\n                      Arg.Unit (fun () -> var_set \"true\"),\n                      Printf.sprintf (f_ \" %s%s\") hlp dflt;\n\n                      arg_concat \"--disable-\" arg_name,\n                      Arg.Unit (fun () -> var_set \"false\"),\n                      Printf.sprintf (f_ \" %s%s\") hlp dflt\n                    ]\n                  | CLIUser lst ->\n                    lst\n              in\n              args :: acc)\n           []\n           schema)\nend\n\nmodule BaseArgExt = struct\n(* # 22 \"src/base/BaseArgExt.ml\" *)\n\n\n  open OASISUtils\n  open OASISGettext\n\n\n  let parse argv args =\n    (* Simulate command line for Arg *)\n    let current =\n      ref 0\n    in\n\n    try\n      Arg.parse_argv\n        ~current:current\n        (Array.concat [[|\"none\"|]; argv])\n        (Arg.align args)\n        (failwithf (f_ \"Don't know what to do with arguments: '%s'\"))\n        (s_ \"configure options:\")\n    with\n      | Arg.Help txt ->\n        print_endline txt;\n        exit 0\n      | Arg.Bad txt ->\n        prerr_endline txt;\n        exit 1\nend\n\nmodule BaseCheck = struct\n(* # 22 \"src/base/BaseCheck.ml\" *)\n\n\n  open BaseEnv\n  open BaseMessage\n  open OASISUtils\n  open OASISGettext\n\n\n  let prog_best prg prg_lst =\n    var_redefine\n      prg\n      (fun () ->\n         let alternate =\n           List.fold_left\n             (fun res e ->\n                match res with\n                  | Some _ ->\n                    res\n                  | None ->\n                    try\n                      Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)\n                    with Not_found ->\n                      None)\n             None\n             prg_lst\n         in\n         match alternate with\n           | Some prg -> prg\n           | None -> raise Not_found)\n\n\n  let prog prg =\n    prog_best prg [prg]\n\n\n  let prog_opt prg =\n    prog_best prg [prg^\".opt\"; prg]\n\n\n  let ocamlfind =\n    prog \"ocamlfind\"\n\n\n  let version\n      var_prefix\n      cmp\n      fversion\n      () =\n    (* Really compare version provided *)\n    let var =\n      var_prefix^\"_version_\"^(OASISVersion.varname_of_comparator cmp)\n    in\n    var_redefine\n      ~hide:true\n      var\n      (fun () ->\n         let version_str =\n           match fversion () with\n             | \"[Distributed with OCaml]\" ->\n               begin\n                 try\n                   (var_get \"ocaml_version\")\n                 with Not_found ->\n                   warning\n                     (f_ \"Variable ocaml_version not defined, fallback \\\n                          to default\");\n                   Sys.ocaml_version\n               end\n             | res ->\n               res\n         in\n         let version =\n           OASISVersion.version_of_string version_str\n         in\n         if OASISVersion.comparator_apply version cmp then\n           version_str\n         else\n           failwithf\n             (f_ \"Cannot satisfy version constraint on %s: %s (version: %s)\")\n             var_prefix\n             (OASISVersion.string_of_comparator cmp)\n             version_str)\n      ()\n\n\n  let package_version pkg =\n    OASISExec.run_read_one_line ~ctxt:!BaseContext.default\n      (ocamlfind ())\n      [\"query\"; \"-format\"; \"%v\"; pkg]\n\n\n  let package ?version_comparator pkg () =\n    let var =\n      OASISUtils.varname_concat\n        \"pkg_\"\n        (OASISUtils.varname_of_string pkg)\n    in\n    let findlib_dir pkg =\n      let dir =\n        OASISExec.run_read_one_line ~ctxt:!BaseContext.default\n          (ocamlfind ())\n          [\"query\"; \"-format\"; \"%d\"; pkg]\n      in\n      if Sys.file_exists dir && Sys.is_directory dir then\n        dir\n      else\n        failwithf\n          (f_ \"When looking for findlib package %s, \\\n               directory %s return doesn't exist\")\n          pkg dir\n    in\n    let vl =\n      var_redefine\n        var\n        (fun () -> findlib_dir pkg)\n        ()\n    in\n    (\n      match version_comparator with\n        | Some ver_cmp ->\n          ignore\n            (version\n               var\n               ver_cmp\n               (fun _ -> package_version pkg)\n               ())\n        | None ->\n          ()\n    );\n    vl\nend\n\nmodule BaseOCamlcConfig = struct\n(* # 22 \"src/base/BaseOCamlcConfig.ml\" *)\n\n\n  open BaseEnv\n  open OASISUtils\n  open OASISGettext\n\n\n  module SMap = Map.Make(String)\n\n\n  let ocamlc =\n    BaseCheck.prog_opt \"ocamlc\"\n\n\n  let ocamlc_config_map =\n    (* Map name to value for ocamlc -config output\n       (name ^\": \"^value)\n    *)\n    let rec split_field mp lst =\n      match lst with\n        | line :: tl ->\n          let mp =\n            try\n              let pos_semicolon =\n                String.index line ':'\n              in\n              if pos_semicolon > 1 then\n                (\n                  let name =\n                    String.sub line 0 pos_semicolon\n                  in\n                  let linelen =\n                    String.length line\n                  in\n                  let value =\n                    if linelen > pos_semicolon + 2 then\n                      String.sub\n                        line\n                        (pos_semicolon + 2)\n                        (linelen - pos_semicolon - 2)\n                    else\n                      \"\"\n                  in\n                  SMap.add name value mp\n                )\n              else\n                (\n                  mp\n                )\n            with Not_found ->\n              (\n                mp\n              )\n          in\n          split_field mp tl\n        | [] ->\n          mp\n    in\n\n    let cache =\n      lazy\n        (var_protect\n           (Marshal.to_string\n              (split_field\n                 SMap.empty\n                 (OASISExec.run_read_output\n                    ~ctxt:!BaseContext.default\n                    (ocamlc ()) [\"-config\"]))\n              []))\n    in\n    var_redefine\n      \"ocamlc_config_map\"\n      ~hide:true\n      ~dump:false\n      (fun () ->\n         (* TODO: update if ocamlc change !!! *)\n         Lazy.force cache)\n\n\n  let var_define nm =\n    (* Extract data from ocamlc -config *)\n    let avlbl_config_get () =\n      Marshal.from_string\n        (ocamlc_config_map ())\n        0\n    in\n    let chop_version_suffix s =\n      try\n        String.sub s 0 (String.index s '+')\n      with _ ->\n        s\n    in\n\n    let nm_config, value_config =\n      match nm with\n        | \"ocaml_version\" ->\n          \"version\", chop_version_suffix\n        | _ -> nm, (fun x -> x)\n    in\n    var_redefine\n      nm\n      (fun () ->\n         try\n           let map =\n             avlbl_config_get ()\n           in\n           let value =\n             SMap.find nm_config map\n           in\n           value_config value\n         with Not_found ->\n           failwithf\n             (f_ \"Cannot find field '%s' in '%s -config' output\")\n             nm\n             (ocamlc ()))\n\nend\n\nmodule BaseStandardVar = struct\n(* # 22 \"src/base/BaseStandardVar.ml\" *)\n\n\n  open OASISGettext\n  open OASISTypes\n  open BaseCheck\n  open BaseEnv\n\n\n  let ocamlfind  = BaseCheck.ocamlfind\n  let ocamlc     = BaseOCamlcConfig.ocamlc\n  let ocamlopt   = prog_opt \"ocamlopt\"\n  let ocamlbuild = prog \"ocamlbuild\"\n\n\n  (**/**)\n  let rpkg =\n    ref None\n\n\n  let pkg_get () =\n    match !rpkg with\n      | Some pkg -> pkg\n      | None -> failwith (s_ \"OASIS Package is not set\")\n\n\n  let var_cond = ref []\n\n\n  let var_define_cond ~since_version f dflt =\n    let holder = ref (fun () -> dflt) in\n    let since_version =\n      OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)\n    in\n    var_cond :=\n      (fun ver ->\n         if OASISVersion.comparator_apply ver since_version then\n           holder := f ()) :: !var_cond;\n    fun () -> !holder ()\n\n\n  (**/**)\n\n\n  let pkg_name =\n    var_define\n      ~short_desc:(fun () -> s_ \"Package name\")\n      \"pkg_name\"\n      (fun () -> (pkg_get ()).name)\n\n\n  let pkg_version =\n    var_define\n      ~short_desc:(fun () -> s_ \"Package version\")\n      \"pkg_version\"\n      (fun () ->\n         (OASISVersion.string_of_version (pkg_get ()).version))\n\n\n  let c = BaseOCamlcConfig.var_define\n\n\n  let os_type        = c \"os_type\"\n  let system         = c \"system\"\n  let architecture   = c \"architecture\"\n  let ccomp_type     = c \"ccomp_type\"\n  let ocaml_version  = c \"ocaml_version\"\n\n\n  (* TODO: Check standard variable presence at runtime *)\n\n\n  let standard_library_default = c \"standard_library_default\"\n  let standard_library         = c \"standard_library\"\n  let standard_runtime         = c \"standard_runtime\"\n  let bytecomp_c_compiler      = c \"bytecomp_c_compiler\"\n  let native_c_compiler        = c \"native_c_compiler\"\n  let model                    = c \"model\"\n  let ext_obj                  = c \"ext_obj\"\n  let ext_asm                  = c \"ext_asm\"\n  let ext_lib                  = c \"ext_lib\"\n  let ext_dll                  = c \"ext_dll\"\n  let default_executable_name  = c \"default_executable_name\"\n  let systhread_supported      = c \"systhread_supported\"\n\n\n  let flexlink =\n    BaseCheck.prog \"flexlink\"\n\n\n  let flexdll_version =\n    var_define\n      ~short_desc:(fun () -> \"FlexDLL version (Win32)\")\n      \"flexdll_version\"\n      (fun () ->\n         let lst =\n           OASISExec.run_read_output ~ctxt:!BaseContext.default\n             (flexlink ()) [\"-help\"]\n         in\n         match lst with\n           | line :: _ ->\n             Scanf.sscanf line \"FlexDLL version %s\" (fun ver -> ver)\n           | [] ->\n             raise Not_found)\n\n\n  (**/**)\n  let p name hlp dflt =\n    var_define\n      ~short_desc:hlp\n      ~cli:CLIAuto\n      ~arg_help:\"dir\"\n      name\n      dflt\n\n\n  let (/) a b =\n    if os_type () = Sys.os_type then\n      Filename.concat a b\n    else if os_type () = \"Unix\" || os_type () = \"Cygwin\" then\n      OASISUnixPath.concat a b\n    else\n      OASISUtils.failwithf (f_ \"Cannot handle os_type %s filename concat\")\n        (os_type ())\n  (**/**)\n\n\n  let prefix =\n    p \"prefix\"\n      (fun () -> s_ \"Install architecture-independent files dir\")\n      (fun () ->\n         match os_type () with\n           | \"Win32\" ->\n             let program_files =\n               Sys.getenv \"PROGRAMFILES\"\n             in\n             program_files/(pkg_name ())\n           | _ ->\n             \"/usr/local\")\n\n\n  let exec_prefix =\n    p \"exec_prefix\"\n      (fun () -> s_ \"Install architecture-dependent files in dir\")\n      (fun () -> \"$prefix\")\n\n\n  let bindir =\n    p \"bindir\"\n      (fun () -> s_ \"User executables\")\n      (fun () -> \"$exec_prefix\"/\"bin\")\n\n\n  let sbindir =\n    p \"sbindir\"\n      (fun () -> s_ \"System admin executables\")\n      (fun () -> \"$exec_prefix\"/\"sbin\")\n\n\n  let libexecdir =\n    p \"libexecdir\"\n      (fun () -> s_ \"Program executables\")\n      (fun () -> \"$exec_prefix\"/\"libexec\")\n\n\n  let sysconfdir =\n    p \"sysconfdir\"\n      (fun () -> s_ \"Read-only single-machine data\")\n      (fun () -> \"$prefix\"/\"etc\")\n\n\n  let sharedstatedir =\n    p \"sharedstatedir\"\n      (fun () -> s_ \"Modifiable architecture-independent data\")\n      (fun () -> \"$prefix\"/\"com\")\n\n\n  let localstatedir =\n    p \"localstatedir\"\n      (fun () -> s_ \"Modifiable single-machine data\")\n      (fun () -> \"$prefix\"/\"var\")\n\n\n  let libdir =\n    p \"libdir\"\n      (fun () -> s_ \"Object code libraries\")\n      (fun () -> \"$exec_prefix\"/\"lib\")\n\n\n  let datarootdir =\n    p \"datarootdir\"\n      (fun () -> s_ \"Read-only arch-independent data root\")\n      (fun () -> \"$prefix\"/\"share\")\n\n\n  let datadir =\n    p \"datadir\"\n      (fun () -> s_ \"Read-only architecture-independent data\")\n      (fun () -> \"$datarootdir\")\n\n\n  let infodir =\n    p \"infodir\"\n      (fun () -> s_ \"Info documentation\")\n      (fun () -> \"$datarootdir\"/\"info\")\n\n\n  let localedir =\n    p \"localedir\"\n      (fun () -> s_ \"Locale-dependent data\")\n      (fun () -> \"$datarootdir\"/\"locale\")\n\n\n  let mandir =\n    p \"mandir\"\n      (fun () -> s_ \"Man documentation\")\n      (fun () -> \"$datarootdir\"/\"man\")\n\n\n  let docdir =\n    p \"docdir\"\n      (fun () -> s_ \"Documentation root\")\n      (fun () -> \"$datarootdir\"/\"doc\"/\"$pkg_name\")\n\n\n  let htmldir =\n    p \"htmldir\"\n      (fun () -> s_ \"HTML documentation\")\n      (fun () -> \"$docdir\")\n\n\n  let dvidir =\n    p \"dvidir\"\n      (fun () -> s_ \"DVI documentation\")\n      (fun () -> \"$docdir\")\n\n\n  let pdfdir =\n    p \"pdfdir\"\n      (fun () -> s_ \"PDF documentation\")\n      (fun () -> \"$docdir\")\n\n\n  let psdir =\n    p \"psdir\"\n      (fun () -> s_ \"PS documentation\")\n      (fun () -> \"$docdir\")\n\n\n  let destdir =\n    p \"destdir\"\n      (fun () -> s_ \"Prepend a path when installing package\")\n      (fun () ->\n         raise\n           (PropList.Not_set\n              (\"destdir\",\n               Some (s_ \"undefined by construct\"))))\n\n\n  let findlib_version =\n    var_define\n      \"findlib_version\"\n      (fun () ->\n         BaseCheck.package_version \"findlib\")\n\n\n  let is_native =\n    var_define\n      \"is_native\"\n      (fun () ->\n         try\n           let _s: string =\n             ocamlopt ()\n           in\n           \"true\"\n         with PropList.Not_set _ ->\n           let _s: string =\n             ocamlc ()\n           in\n           \"false\")\n\n\n  let ext_program =\n    var_define\n      \"suffix_program\"\n      (fun () ->\n         match os_type () with\n           | \"Win32\" | \"Cygwin\" -> \".exe\"\n           | _ -> \"\")\n\n\n  let rm =\n    var_define\n      ~short_desc:(fun () -> s_ \"Remove a file.\")\n      \"rm\"\n      (fun () ->\n         match os_type () with\n           | \"Win32\" -> \"del\"\n           | _ -> \"rm -f\")\n\n\n  let rmdir =\n    var_define\n      ~short_desc:(fun () -> s_ \"Remove a directory.\")\n      \"rmdir\"\n      (fun () ->\n         match os_type () with\n           | \"Win32\" -> \"rd\"\n           | _ -> \"rm -rf\")\n\n\n  let debug =\n    var_define\n      ~short_desc:(fun () -> s_ \"Turn ocaml debug flag on\")\n      ~cli:CLIEnable\n      \"debug\"\n      (fun () -> \"true\")\n\n\n  let profile =\n    var_define\n      ~short_desc:(fun () -> s_ \"Turn ocaml profile flag on\")\n      ~cli:CLIEnable\n      \"profile\"\n      (fun () -> \"false\")\n\n\n  let tests =\n    var_define_cond ~since_version:\"0.3\"\n      (fun () ->\n         var_define\n           ~short_desc:(fun () ->\n             s_ \"Compile tests executable and library and run them\")\n           ~cli:CLIEnable\n           \"tests\"\n           (fun () -> \"false\"))\n      \"true\"\n\n\n  let docs =\n    var_define_cond ~since_version:\"0.3\"\n      (fun () ->\n         var_define\n           ~short_desc:(fun () -> s_ \"Create documentations\")\n           ~cli:CLIEnable\n           \"docs\"\n           (fun () -> \"true\"))\n      \"true\"\n\n\n  let native_dynlink =\n    var_define\n      ~short_desc:(fun () -> s_ \"Compiler support generation of .cmxs.\")\n      ~cli:CLINone\n      \"native_dynlink\"\n      (fun () ->\n         let res =\n           let ocaml_lt_312 () =\n             OASISVersion.comparator_apply\n               (OASISVersion.version_of_string (ocaml_version ()))\n               (OASISVersion.VLesser\n                  (OASISVersion.version_of_string \"3.12.0\"))\n           in\n           let flexdll_lt_030 () =\n             OASISVersion.comparator_apply\n               (OASISVersion.version_of_string (flexdll_version ()))\n               (OASISVersion.VLesser\n                  (OASISVersion.version_of_string \"0.30\"))\n           in\n           let has_native_dynlink =\n             let ocamlfind = ocamlfind () in\n             try\n               let fn =\n                 OASISExec.run_read_one_line\n                   ~ctxt:!BaseContext.default\n                   ocamlfind\n                   [\"query\"; \"-predicates\"; \"native\"; \"dynlink\";\n                    \"-format\"; \"%d/%a\"]\n               in\n               Sys.file_exists fn\n             with _ ->\n               false\n           in\n           if not has_native_dynlink then\n             false\n           else if ocaml_lt_312 () then\n             false\n           else if (os_type () = \"Win32\" || os_type () = \"Cygwin\")\n                && flexdll_lt_030 () then\n             begin\n               BaseMessage.warning\n                 (f_ \".cmxs generation disabled because FlexDLL needs to be \\\n                      at least 0.30. Please upgrade FlexDLL from %s to 0.30.\")\n                 (flexdll_version ());\n               false\n             end\n           else\n             true\n         in\n         string_of_bool res)\n\n\n  let init pkg =\n    rpkg := Some pkg;\n    List.iter (fun f -> f pkg.oasis_version) !var_cond\n\nend\n\nmodule BaseFileAB = struct\n(* # 22 \"src/base/BaseFileAB.ml\" *)\n\n\n  open BaseEnv\n  open OASISGettext\n  open BaseMessage\n  open OASISContext\n\n\n  let to_filename fn =\n    if not (Filename.check_suffix fn \".ab\") then\n      warning (f_ \"File '%s' doesn't have '.ab' extension\") fn;\n    OASISFileSystem.of_unix_filename (Filename.chop_extension fn)\n\n\n  let replace ~ctxt fn_lst =\n    let open OASISFileSystem in\n    let ibuf, obuf = Buffer.create 13, Buffer.create 13 in\n    List.iter\n      (fun fn ->\n         Buffer.clear ibuf; Buffer.clear obuf;\n         defer_close\n           (ctxt.srcfs#open_in (of_unix_filename fn))\n           (read_all ibuf);\n         Buffer.add_string obuf (var_expand (Buffer.contents ibuf));\n         defer_close\n           (ctxt.srcfs#open_out (to_filename fn))\n           (fun wrtr -> wrtr#output obuf))\n      fn_lst\nend\n\nmodule BaseLog = struct\n(* # 22 \"src/base/BaseLog.ml\" *)\n\n\n  open OASISUtils\n  open OASISContext\n  open OASISGettext\n  open OASISFileSystem\n\n\n  let default_filename = in_srcdir \"setup.log\"\n\n\n  let load ~ctxt () =\n    let module SetTupleString =\n      Set.Make\n        (struct\n          type t = string * string\n          let compare (s11, s12) (s21, s22) =\n            match String.compare s11 s21 with\n            | 0 -> String.compare s12 s22\n            | n -> n\n        end)\n    in\n    if ctxt.srcfs#file_exists default_filename then begin\n      defer_close\n        (ctxt.srcfs#open_in default_filename)\n        (fun rdr ->\n           let line = ref 1 in\n           let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in\n           let rec read_aux (st, lst) =\n             match Stream.npeek 2 lxr with\n             | [Genlex.String e; Genlex.String d] ->\n               let t = e, d in\n               Stream.junk lxr; Stream.junk lxr;\n               if SetTupleString.mem t st then\n                 read_aux (st, lst)\n               else\n                 read_aux (SetTupleString.add t st, t :: lst)\n             | [] -> List.rev lst\n             | _ ->\n               failwithf\n                 (f_ \"Malformed log file '%s' at line %d\")\n                 (ctxt.srcfs#string_of_filename default_filename)\n                 !line\n           in\n           read_aux (SetTupleString.empty, []))\n    end else begin\n      []\n    end\n\n\n  let register ~ctxt event data =\n    defer_close\n      (ctxt.srcfs#open_out\n         ~mode:[Open_append; Open_creat; Open_text]\n         ~perm:0o644\n         default_filename)\n      (fun wrtr ->\n         let buf = Buffer.create 13 in\n         Printf.bprintf buf \"%S %S\\n\" event data;\n         wrtr#output buf)\n\n\n  let unregister ~ctxt event data =\n    let lst = load ~ctxt () in\n    let buf = Buffer.create 13 in\n    List.iter\n      (fun (e, d) ->\n         if e <> event || d <> data then\n           Printf.bprintf buf \"%S %S\\n\" e d)\n      lst;\n    if Buffer.length buf > 0 then\n      defer_close\n        (ctxt.srcfs#open_out default_filename)\n        (fun wrtr -> wrtr#output buf)\n    else\n      ctxt.srcfs#remove default_filename\n\n\n  let filter ~ctxt events =\n    let st_events = SetString.of_list events in\n    List.filter\n      (fun (e, _) -> SetString.mem e st_events)\n      (load ~ctxt ())\n\n\n  let exists ~ctxt event data =\n    List.exists\n      (fun v -> (event, data) = v)\n      (load ~ctxt ())\nend\n\nmodule BaseBuilt = struct\n(* # 22 \"src/base/BaseBuilt.ml\" *)\n\n\n  open OASISTypes\n  open OASISGettext\n  open BaseStandardVar\n  open BaseMessage\n\n\n  type t =\n    | BExec    (* Executable *)\n    | BExecLib (* Library coming with executable *)\n    | BLib     (* Library *)\n    | BObj     (* Library *)\n    | BDoc     (* Document *)\n\n\n  let to_log_event_file t nm =\n    \"built_\"^\n      (match t with\n        | BExec -> \"exec\"\n        | BExecLib -> \"exec_lib\"\n        | BLib -> \"lib\"\n        | BObj -> \"obj\"\n        | BDoc -> \"doc\")^\n      \"_\"^nm\n\n\n  let to_log_event_done t nm =\n    \"is_\"^(to_log_event_file t nm)\n\n\n  let register ~ctxt t nm lst =\n    BaseLog.register ~ctxt (to_log_event_done t nm) \"true\";\n    List.iter\n      (fun alt ->\n         let registered =\n           List.fold_left\n             (fun registered fn ->\n                if OASISFileUtil.file_exists_case fn then begin\n                  BaseLog.register ~ctxt\n                    (to_log_event_file t nm)\n                    (if Filename.is_relative fn then\n                       Filename.concat (Sys.getcwd ()) fn\n                     else\n                       fn);\n                  true\n                end else begin\n                  registered\n                end)\n             false\n             alt\n         in\n         if not registered then\n           warning\n             (f_ \"Cannot find an existing alternative files among: %s\")\n             (String.concat (s_ \", \") alt))\n      lst\n\n\n  let unregister ~ctxt t nm =\n    List.iter\n      (fun (e, d) -> BaseLog.unregister ~ctxt e d)\n      (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm])\n\n\n  let fold ~ctxt t nm f acc =\n    List.fold_left\n      (fun acc (_, fn) ->\n         if OASISFileUtil.file_exists_case fn then begin\n           f acc fn\n         end else begin\n           warning\n             (f_ \"File '%s' has been marked as built \\\n                  for %s but doesn't exist\")\n             fn\n             (Printf.sprintf\n                (match t with\n                  | BExec | BExecLib -> (f_ \"executable %s\")\n                  | BLib -> (f_ \"library %s\")\n                  | BObj -> (f_ \"object %s\")\n                  | BDoc -> (f_ \"documentation %s\"))\n                nm);\n           acc\n         end)\n      acc\n      (BaseLog.filter ~ctxt [to_log_event_file t nm])\n\n\n  let is_built ~ctxt t nm =\n    List.fold_left\n      (fun _ (_, d) -> try bool_of_string d with _ -> false)\n      false\n      (BaseLog.filter ~ctxt [to_log_event_done t nm])\n\n\n  let of_executable ffn (cs, bs, exec) =\n    let unix_exec_is, unix_dll_opt =\n      OASISExecutable.unix_exec_is\n        (cs, bs, exec)\n        (fun () ->\n           bool_of_string\n             (is_native ()))\n        ext_dll\n        ext_program\n    in\n    let evs =\n      (BExec, cs.cs_name, [[ffn unix_exec_is]])\n      ::\n        (match unix_dll_opt with\n          | Some fn ->\n            [BExecLib, cs.cs_name, [[ffn fn]]]\n          | None ->\n            [])\n    in\n    evs,\n    unix_exec_is,\n    unix_dll_opt\n\n\n  let of_library ffn (cs, bs, lib) =\n    let unix_lst =\n      OASISLibrary.generated_unix_files\n        ~ctxt:!BaseContext.default\n        ~source_file_exists:(fun fn ->\n          OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))\n        ~is_native:(bool_of_string (is_native ()))\n        ~has_native_dynlink:(bool_of_string (native_dynlink ()))\n        ~ext_lib:(ext_lib ())\n        ~ext_dll:(ext_dll ())\n        (cs, bs, lib)\n    in\n    let evs =\n      [BLib,\n       cs.cs_name,\n       List.map (List.map ffn) unix_lst]\n    in\n    evs, unix_lst\n\n\n  let of_object ffn (cs, bs, obj) =\n    let unix_lst =\n      OASISObject.generated_unix_files\n        ~ctxt:!BaseContext.default\n        ~source_file_exists:(fun fn ->\n          OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))\n        ~is_native:(bool_of_string (is_native ()))\n        (cs, bs, obj)\n    in\n    let evs =\n      [BObj,\n       cs.cs_name,\n       List.map (List.map ffn) unix_lst]\n    in\n    evs, unix_lst\n\nend\n\nmodule BaseCustom = struct\n(* # 22 \"src/base/BaseCustom.ml\" *)\n\n\n  open BaseEnv\n  open BaseMessage\n  open OASISTypes\n  open OASISGettext\n\n\n  let run cmd args extra_args =\n    OASISExec.run ~ctxt:!BaseContext.default ~quote:false\n      (var_expand cmd)\n      (List.map\n         var_expand\n         (args @ (Array.to_list extra_args)))\n\n\n  let hook ?(failsafe=false) cstm f e =\n    let optional_command lst =\n      let printer =\n        function\n          | Some (cmd, args) -> String.concat \" \" (cmd :: args)\n          | None -> s_ \"No command\"\n      in\n      match\n        var_choose\n          ~name:(s_ \"Pre/Post Command\")\n          ~printer\n          lst with\n        | Some (cmd, args) ->\n          begin\n            try\n              run cmd args [||]\n            with e when failsafe ->\n              warning\n                (f_ \"Command '%s' fail with error: %s\")\n                (String.concat \" \" (cmd :: args))\n                (match e with\n                  | Failure msg -> msg\n                  | e -> Printexc.to_string e)\n          end\n        | None ->\n          ()\n    in\n    let res =\n      optional_command cstm.pre_command;\n      f e\n    in\n    optional_command cstm.post_command;\n    res\nend\n\nmodule BaseDynVar = struct\n(* # 22 \"src/base/BaseDynVar.ml\" *)\n\n\n  open OASISTypes\n  open OASISGettext\n  open BaseEnv\n  open BaseBuilt\n\n\n  let init ~ctxt pkg =\n    (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)\n    (* TODO: provide compile option for library libary_byte_args_VARNAME... *)\n    List.iter\n      (function\n        | Executable (cs, bs, _) ->\n          if var_choose bs.bs_build then\n            var_ignore\n              (var_redefine\n                 (* We don't save this variable *)\n                 ~dump:false\n                 ~short_desc:(fun () ->\n                   Printf.sprintf\n                     (f_ \"Filename of executable '%s'\")\n                     cs.cs_name)\n                 (OASISUtils.varname_of_string cs.cs_name)\n                 (fun () ->\n                    let fn_opt =\n                      fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None\n                    in\n                    match fn_opt with\n                    | Some fn -> fn\n                    | None ->\n                      raise\n                        (PropList.Not_set\n                           (cs.cs_name,\n                            Some (Printf.sprintf\n                                    (f_ \"Executable '%s' not yet built.\")\n                                    cs.cs_name)))))\n\n        | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->\n          ())\n      pkg.sections\nend\n\nmodule BaseTest = struct\n(* # 22 \"src/base/BaseTest.ml\" *)\n\n\n  open BaseEnv\n  open BaseMessage\n  open OASISTypes\n  open OASISGettext\n\n\n  let test ~ctxt lst pkg extra_args =\n\n    let one_test (failure, n) (test_plugin, cs, test) =\n      if var_choose\n          ~name:(Printf.sprintf\n              (f_ \"test %s run\")\n              cs.cs_name)\n          ~printer:string_of_bool\n          test.test_run then\n        begin\n          let () = info (f_ \"Running test '%s'\") cs.cs_name in\n          let back_cwd =\n            match test.test_working_directory with\n              | Some dir ->\n                let cwd = Sys.getcwd () in\n                let chdir d =\n                  info (f_ \"Changing directory to '%s'\") d;\n                  Sys.chdir d\n                in\n                chdir dir;\n                fun () -> chdir cwd\n\n              | None ->\n                fun () -> ()\n          in\n          try\n            let failure_percent =\n              BaseCustom.hook\n                test.test_custom\n                (test_plugin ~ctxt pkg (cs, test))\n                extra_args\n            in\n            back_cwd ();\n            (failure_percent +. failure, n + 1)\n          with e ->\n            begin\n              back_cwd ();\n              raise e\n            end\n        end\n      else\n        begin\n          info (f_ \"Skipping test '%s'\") cs.cs_name;\n          (failure, n)\n        end\n    in\n    let failed, n = List.fold_left one_test (0.0, 0) lst in\n    let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in\n    let msg =\n      Printf.sprintf\n        (f_ \"Tests had a %.2f%% failure rate\")\n        (100. *. failure_percent)\n    in\n    if failure_percent > 0.0 then\n      failwith msg\n    else\n      info \"%s\" msg;\n\n    (* Possible explanation why the tests where not run. *)\n    if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&\n       not (bool_of_string (BaseStandardVar.tests ())) &&\n       lst <> [] then\n      BaseMessage.warning\n        \"Tests are turned off, consider enabling with \\\n         'ocaml setup.ml -configure --enable-tests'\"\nend\n\nmodule BaseDoc = struct\n(* # 22 \"src/base/BaseDoc.ml\" *)\n\n\n  open BaseEnv\n  open BaseMessage\n  open OASISTypes\n  open OASISGettext\n\n\n  let doc ~ctxt lst pkg extra_args =\n\n    let one_doc (doc_plugin, cs, doc) =\n      if var_choose\n          ~name:(Printf.sprintf\n              (f_ \"documentation %s build\")\n              cs.cs_name)\n          ~printer:string_of_bool\n          doc.doc_build then\n        begin\n          info (f_ \"Building documentation '%s'\") cs.cs_name;\n          BaseCustom.hook\n            doc.doc_custom\n            (doc_plugin ~ctxt pkg (cs, doc))\n            extra_args\n        end\n    in\n    List.iter one_doc lst;\n\n    if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&\n       not (bool_of_string (BaseStandardVar.docs ())) &&\n       lst <> [] then\n      BaseMessage.warning\n        \"Docs are turned off, consider enabling with \\\n         'ocaml setup.ml -configure --enable-docs'\"\nend\n\nmodule BaseSetup = struct\n(* # 22 \"src/base/BaseSetup.ml\" *)\n\n  open OASISContext\n  open BaseEnv\n  open BaseMessage\n  open OASISTypes\n  open OASISGettext\n  open OASISUtils\n\n\n  type std_args_fun =\n    ctxt:OASISContext.t -> package -> string array -> unit\n\n\n  type ('a, 'b) section_args_fun =\n    name *\n    (ctxt:OASISContext.t ->\n     package ->\n     (common_section * 'a) ->\n     string array ->\n     'b)\n\n\n  type t =\n    {\n      configure:        std_args_fun;\n      build:            std_args_fun;\n      doc:              ((doc, unit)  section_args_fun) list;\n      test:             ((test, float) section_args_fun) list;\n      install:          std_args_fun;\n      uninstall:        std_args_fun;\n      clean:            std_args_fun list;\n      clean_doc:        (doc, unit) section_args_fun list;\n      clean_test:       (test, unit) section_args_fun list;\n      distclean:        std_args_fun list;\n      distclean_doc:    (doc, unit) section_args_fun list;\n      distclean_test:   (test, unit) section_args_fun list;\n      package:          package;\n      oasis_fn:         string option;\n      oasis_version:    string;\n      oasis_digest:     Digest.t option;\n      oasis_exec:       string option;\n      oasis_setup_args: string list;\n      setup_update:     bool;\n    }\n\n\n  (* Associate a plugin function with data from package *)\n  let join_plugin_sections filter_map lst =\n    List.rev\n      (List.fold_left\n         (fun acc sct ->\n            match filter_map sct with\n              | Some e ->\n                e :: acc\n              | None ->\n                acc)\n         []\n         lst)\n\n\n  (* Search for plugin data associated with a section name *)\n  let lookup_plugin_section plugin action nm lst =\n    try\n      List.assoc nm lst\n    with Not_found ->\n      failwithf\n        (f_ \"Cannot find plugin %s matching section %s for %s action\")\n        plugin\n        nm\n        action\n\n\n  let configure ~ctxt t args =\n    (* Run configure *)\n    BaseCustom.hook\n      t.package.conf_custom\n      (fun () ->\n         (* Reload if preconf has changed it *)\n         begin\n           try\n             unload ();\n             load ~ctxt ();\n           with _ ->\n             ()\n         end;\n\n         (* Run plugin's configure *)\n         t.configure ~ctxt t.package args;\n\n         (* Dump to allow postconf to change it *)\n         dump ~ctxt ())\n      ();\n\n    (* Reload environment *)\n    unload ();\n    load ~ctxt ();\n\n    (* Save environment *)\n    print ();\n\n    (* Replace data in file *)\n    BaseFileAB.replace ~ctxt t.package.files_ab\n\n\n  let build ~ctxt t args =\n    BaseCustom.hook\n      t.package.build_custom\n      (t.build ~ctxt t.package)\n      args\n\n\n  let doc ~ctxt t args =\n    BaseDoc.doc\n      ~ctxt\n      (join_plugin_sections\n         (function\n           | Doc (cs, e) ->\n             Some\n               (lookup_plugin_section\n                  \"documentation\"\n                  (s_ \"build\")\n                  cs.cs_name\n                  t.doc,\n                cs,\n                e)\n           | _ ->\n             None)\n         t.package.sections)\n      t.package\n      args\n\n\n  let test ~ctxt t args =\n    BaseTest.test\n      ~ctxt\n      (join_plugin_sections\n         (function\n           | Test (cs, e) ->\n             Some\n               (lookup_plugin_section\n                  \"test\"\n                  (s_ \"run\")\n                  cs.cs_name\n                  t.test,\n                cs,\n                e)\n           | _ ->\n             None)\n         t.package.sections)\n      t.package\n      args\n\n\n  let all ~ctxt t args =\n    let rno_doc = ref false in\n    let rno_test = ref false in\n    let arg_rest = ref [] in\n    Arg.parse_argv\n      ~current:(ref 0)\n      (Array.of_list\n         ((Sys.executable_name^\" all\") ::\n            (Array.to_list args)))\n      [\n        \"-no-doc\",\n        Arg.Set rno_doc,\n        s_ \"Don't run doc target\";\n\n        \"-no-test\",\n        Arg.Set rno_test,\n        s_ \"Don't run test target\";\n\n        \"--\",\n        Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),\n        s_ \"All arguments for configure.\";\n      ]\n      (failwithf (f_ \"Don't know what to do with '%s'\"))\n      \"\";\n\n    info \"Running configure step\";\n    configure ~ctxt t (Array.of_list (List.rev !arg_rest));\n\n    info \"Running build step\";\n    build ~ctxt t [||];\n\n    (* Load setup.log dynamic variables *)\n    BaseDynVar.init ~ctxt t.package;\n\n    if not !rno_doc then begin\n      info \"Running doc step\";\n      doc ~ctxt t [||]\n    end else begin\n      info \"Skipping doc step\"\n    end;\n    if not !rno_test then begin\n      info \"Running test step\";\n      test ~ctxt t [||]\n    end else begin\n      info \"Skipping test step\"\n    end\n\n\n  let install ~ctxt t args =\n    BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args\n\n\n  let uninstall ~ctxt t args =\n    BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args\n\n\n  let reinstall ~ctxt t args =\n    uninstall ~ctxt t args;\n    install ~ctxt t args\n\n\n  let clean, distclean =\n    let failsafe f a =\n      try\n        f a\n      with e ->\n        warning\n          (f_ \"Action fail with error: %s\")\n          (match e with\n            | Failure msg -> msg\n            | e -> Printexc.to_string e)\n    in\n\n    let generic_clean ~ctxt t cstm mains docs tests args =\n      BaseCustom.hook\n        ~failsafe:true\n        cstm\n        (fun () ->\n           (* Clean section *)\n           List.iter\n             (function\n               | Test (cs, test) ->\n                 let f =\n                   try\n                     List.assoc cs.cs_name tests\n                   with Not_found ->\n                   fun ~ctxt:_ _ _ _ -> ()\n                 in\n                 failsafe (f ~ctxt t.package (cs, test)) args\n               | Doc (cs, doc) ->\n                 let f =\n                   try\n                     List.assoc cs.cs_name docs\n                   with Not_found ->\n                   fun ~ctxt:_ _ _ _ -> ()\n                 in\n                 failsafe (f ~ctxt t.package (cs, doc)) args\n               | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ())\n             t.package.sections;\n           (* Clean whole package *)\n           List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains)\n        ()\n    in\n\n    let clean ~ctxt t args =\n      generic_clean\n        ~ctxt\n        t\n        t.package.clean_custom\n        t.clean\n        t.clean_doc\n        t.clean_test\n        args\n    in\n\n    let distclean ~ctxt t args =\n      (* Call clean *)\n      clean ~ctxt t args;\n\n      (* Call distclean code *)\n      generic_clean\n        ~ctxt\n        t\n        t.package.distclean_custom\n        t.distclean\n        t.distclean_doc\n        t.distclean_test\n        args;\n\n      (* Remove generated source files. *)\n      List.iter\n        (fun fn ->\n           if ctxt.srcfs#file_exists fn then begin\n             info (f_ \"Remove '%s'\") (ctxt.srcfs#string_of_filename fn);\n             ctxt.srcfs#remove fn\n           end)\n        ([BaseEnv.default_filename; BaseLog.default_filename]\n         @ (List.rev_map BaseFileAB.to_filename t.package.files_ab))\n    in\n\n    clean, distclean\n\n\n  let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version\n\n\n  let update_setup_ml, no_update_setup_ml_cli =\n    let b = ref true in\n    b,\n    (\"-no-update-setup-ml\",\n     Arg.Clear b,\n     s_ \" Don't try to update setup.ml, even if _oasis has changed.\")\n\n  (* TODO: srcfs *)\n  let default_oasis_fn = \"_oasis\"\n\n\n  let update_setup_ml t =\n    let oasis_fn =\n      match t.oasis_fn with\n        | Some fn -> fn\n        | None -> default_oasis_fn\n    in\n    let oasis_exec =\n      match t.oasis_exec with\n        | Some fn -> fn\n        | None -> \"oasis\"\n    in\n    let ocaml =\n      Sys.executable_name\n    in\n    let setup_ml, args =\n      match Array.to_list Sys.argv with\n        | setup_ml :: args ->\n          setup_ml, args\n        | [] ->\n          failwith\n            (s_ \"Expecting non-empty command line arguments.\")\n    in\n    let ocaml, setup_ml =\n      if Sys.executable_name = Sys.argv.(0) then\n        (* We are not running in standard mode, probably the script\n         * is precompiled.\n        *)\n        \"ocaml\", \"setup.ml\"\n      else\n        ocaml, setup_ml\n    in\n    let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in\n    let do_update () =\n      let oasis_exec_version =\n        OASISExec.run_read_one_line\n          ~ctxt:!BaseContext.default\n          ~f_exit_code:\n            (function\n              | 0 ->\n                ()\n              | 1 ->\n                failwithf\n                  (f_ \"Executable '%s' is probably an old version \\\n                       of oasis (< 0.3.0), please update to version \\\n                       v%s.\")\n                  oasis_exec t.oasis_version\n              | 127 ->\n                failwithf\n                  (f_ \"Cannot find executable '%s', please install \\\n                       oasis v%s.\")\n                  oasis_exec t.oasis_version\n              | n ->\n                failwithf\n                  (f_ \"Command '%s version' exited with code %d.\")\n                  oasis_exec n)\n          oasis_exec [\"version\"]\n      in\n      if OASISVersion.comparator_apply\n          (OASISVersion.version_of_string oasis_exec_version)\n          (OASISVersion.VGreaterEqual\n             (OASISVersion.version_of_string t.oasis_version)) then\n        begin\n          (* We have a version >= for the executable oasis, proceed with\n           * update.\n          *)\n          (* TODO: delegate this check to 'oasis setup'. *)\n          if Sys.os_type = \"Win32\" then\n            failwithf\n              (f_ \"It is not possible to update the running script \\\n                   setup.ml on Windows. Please update setup.ml by \\\n                   running '%s'.\")\n              (String.concat \" \" (oasis_exec :: \"setup\" :: t.oasis_setup_args))\n          else\n            begin\n              OASISExec.run\n                ~ctxt:!BaseContext.default\n                ~f_exit_code:\n                  (fun n ->\n                     if n <> 0 then\n                       failwithf\n                         (f_ \"Unable to update setup.ml using '%s', \\\n                              please fix the problem and retry.\")\n                         oasis_exec)\n                oasis_exec (\"setup\" :: t.oasis_setup_args);\n              OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)\n            end\n        end\n      else\n        failwithf\n          (f_ \"The version of '%s' (v%s) doesn't match the version of \\\n               oasis used to generate the %s file. Please install at \\\n               least oasis v%s.\")\n          oasis_exec oasis_exec_version setup_ml t.oasis_version\n    in\n\n    if !update_setup_ml then\n      begin\n        try\n          match t.oasis_digest with\n            | Some dgst ->\n              if Sys.file_exists oasis_fn &&\n                 dgst <> Digest.file default_oasis_fn then\n                begin\n                  do_update ();\n                  true\n                end\n              else\n                false\n            | None ->\n              false\n        with e ->\n          error\n            (f_ \"Error when updating setup.ml. If you want to avoid this error, \\\n                 you can bypass the update of %s by running '%s %s %s %s'\")\n            setup_ml ocaml setup_ml no_update_setup_ml_cli\n            (String.concat \" \" args);\n          raise e\n      end\n    else\n      false\n\n\n  let setup t =\n    let catch_exn = ref true in\n    let act_ref =\n      ref (fun ~ctxt:_ _ ->\n        failwithf\n          (f_ \"No action defined, run '%s %s -help'\")\n          Sys.executable_name\n          Sys.argv.(0))\n\n    in\n    let extra_args_ref = ref [] in\n    let allow_empty_env_ref = ref false in\n    let arg_handle ?(allow_empty_env=false) act =\n      Arg.Tuple\n        [\n          Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);\n          Arg.Unit\n            (fun () ->\n               allow_empty_env_ref := allow_empty_env;\n               act_ref := act);\n        ]\n    in\n    try\n      let () =\n        Arg.parse\n          (Arg.align\n             ([\n               \"-configure\",\n               arg_handle ~allow_empty_env:true configure,\n               s_ \"[options*] Configure the whole build process.\";\n\n               \"-build\",\n               arg_handle build,\n               s_ \"[options*] Build executables and libraries.\";\n\n               \"-doc\",\n               arg_handle doc,\n               s_ \"[options*] Build documents.\";\n\n               \"-test\",\n               arg_handle test,\n               s_ \"[options*] Run tests.\";\n\n               \"-all\",\n               arg_handle ~allow_empty_env:true all,\n               s_ \"[options*] Run configure, build, doc and test targets.\";\n\n               \"-install\",\n               arg_handle install,\n               s_ \"[options*] Install libraries, data, executables \\\n                   and documents.\";\n\n               \"-uninstall\",\n               arg_handle uninstall,\n               s_ \"[options*] Uninstall libraries, data, executables \\\n                   and documents.\";\n\n               \"-reinstall\",\n               arg_handle reinstall,\n               s_ \"[options*] Uninstall and install libraries, data, \\\n                   executables and documents.\";\n\n               \"-clean\",\n               arg_handle ~allow_empty_env:true clean,\n               s_ \"[options*] Clean files generated by a build.\";\n\n               \"-distclean\",\n               arg_handle ~allow_empty_env:true distclean,\n               s_ \"[options*] Clean files generated by a build and configure.\";\n\n               \"-version\",\n               arg_handle ~allow_empty_env:true version,\n               s_ \" Display version of OASIS used to generate this setup.ml.\";\n\n               \"-no-catch-exn\",\n               Arg.Clear catch_exn,\n               s_ \" Don't catch exception, useful for debugging.\";\n             ]\n              @\n                (if t.setup_update then\n                   [no_update_setup_ml_cli]\n                 else\n                   [])\n              @ (BaseContext.args ())))\n          (failwithf (f_ \"Don't know what to do with '%s'\"))\n          (s_ \"Setup and run build process current package\\n\")\n      in\n\n      (* Instantiate the context. *)\n      let ctxt = !BaseContext.default in\n\n      (* Build initial environment *)\n      load ~ctxt ~allow_empty:!allow_empty_env_ref ();\n\n      (** Initialize flags *)\n      List.iter\n        (function\n          | Flag (cs, {flag_description = hlp;\n                       flag_default = choices}) ->\n            begin\n              let apply ?short_desc () =\n                var_ignore\n                  (var_define\n                     ~cli:CLIEnable\n                     ?short_desc\n                     (OASISUtils.varname_of_string cs.cs_name)\n                     (fun () ->\n                        string_of_bool\n                          (var_choose\n                             ~name:(Printf.sprintf\n                                 (f_ \"default value of flag %s\")\n                                 cs.cs_name)\n                             ~printer:string_of_bool\n                             choices)))\n              in\n              match hlp with\n              | Some hlp -> apply ~short_desc:(fun () -> hlp) ()\n              | None -> apply ()\n            end\n          | _ ->\n            ())\n        t.package.sections;\n\n      BaseStandardVar.init t.package;\n\n      BaseDynVar.init ~ctxt t.package;\n\n      if not (t.setup_update && update_setup_ml t) then\n        !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref))\n\n    with e when !catch_exn ->\n      error \"%s\" (Printexc.to_string e);\n      exit 1\n\n\nend\n\nmodule BaseCompat = struct\n(* # 22 \"src/base/BaseCompat.ml\" *)\n\n  (** Compatibility layer to provide a stable API inside setup.ml.\n      This layer allows OASIS to change in between minor versions\n      (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This\n      enables to write functions that manipulate setup_t inside setup.ml. See\n      deps.ml for an example.\n\n      The module opened by default will depend on the version of the _oasis. E.g.\n      if we have \"OASISFormat: 0.3\", the module Compat_0_3 will be opened and\n      the function Compat_0_3 will be called. If setup.ml is generated with the\n      -nocompat, no module will be opened.\n\n      @author Sylvain Le Gall\n    *)\n\n  module Compat_0_4 =\n  struct\n    let rctxt = ref !BaseContext.default\n\n    module BaseSetup =\n    struct\n      module Original = BaseSetup\n\n      open OASISTypes\n\n      type std_args_fun = package -> string array -> unit\n      type ('a, 'b) section_args_fun =\n        name * (package -> (common_section * 'a) -> string array -> 'b)\n      type t =\n        {\n          configure:        std_args_fun;\n          build:            std_args_fun;\n          doc:              ((doc, unit)  section_args_fun) list;\n          test:             ((test, float) section_args_fun) list;\n          install:          std_args_fun;\n          uninstall:        std_args_fun;\n          clean:            std_args_fun list;\n          clean_doc:        (doc, unit) section_args_fun list;\n          clean_test:       (test, unit) section_args_fun list;\n          distclean:        std_args_fun list;\n          distclean_doc:    (doc, unit) section_args_fun list;\n          distclean_test:   (test, unit) section_args_fun list;\n          package:          package;\n          oasis_fn:         string option;\n          oasis_version:    string;\n          oasis_digest:     Digest.t option;\n          oasis_exec:       string option;\n          oasis_setup_args: string list;\n          setup_update:     bool;\n        }\n\n      let setup t =\n        let mk_std_args_fun f =\n          fun ~ctxt pkg args -> rctxt := ctxt; f pkg args\n        in\n        let mk_section_args_fun l =\n          List.map\n            (fun (nm, f) ->\n               nm,\n               (fun ~ctxt pkg sct args ->\n                  rctxt := ctxt;\n                  f pkg sct args))\n            l\n        in\n        let t' =\n          {\n            Original.\n            configure =        mk_std_args_fun t.configure;\n            build =            mk_std_args_fun t.build;\n            doc =              mk_section_args_fun t.doc;\n            test =             mk_section_args_fun t.test;\n            install =          mk_std_args_fun t.install;\n            uninstall =        mk_std_args_fun t.uninstall;\n            clean =            List.map mk_std_args_fun t.clean;\n            clean_doc =        mk_section_args_fun t.clean_doc;\n            clean_test =       mk_section_args_fun t.clean_test;\n            distclean =        List.map mk_std_args_fun t.distclean;\n            distclean_doc =    mk_section_args_fun t.distclean_doc;\n            distclean_test =   mk_section_args_fun t.distclean_test;\n\n            package =          t.package;\n            oasis_fn =         t.oasis_fn;\n            oasis_version =    t.oasis_version;\n            oasis_digest =     t.oasis_digest;\n            oasis_exec =       t.oasis_exec;\n            oasis_setup_args = t.oasis_setup_args;\n            setup_update =     t.setup_update;\n          }\n        in\n        Original.setup t'\n\n    end\n\n    let adapt_setup_t setup_t =\n      let module O = BaseSetup.Original in\n      let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in\n      let mk_section_args_fun l =\n        List.map\n          (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args))\n          l\n      in\n      {\n        BaseSetup.\n        configure =        mk_std_args_fun setup_t.O.configure;\n        build =            mk_std_args_fun setup_t.O.build;\n        doc =              mk_section_args_fun setup_t.O.doc;\n        test =             mk_section_args_fun setup_t.O.test;\n        install =          mk_std_args_fun setup_t.O.install;\n        uninstall =        mk_std_args_fun setup_t.O.uninstall;\n        clean =            List.map mk_std_args_fun setup_t.O.clean;\n        clean_doc =        mk_section_args_fun setup_t.O.clean_doc;\n        clean_test =       mk_section_args_fun setup_t.O.clean_test;\n        distclean =        List.map mk_std_args_fun setup_t.O.distclean;\n        distclean_doc =    mk_section_args_fun setup_t.O.distclean_doc;\n        distclean_test =   mk_section_args_fun setup_t.O.distclean_test;\n\n        package =          setup_t.O.package;\n        oasis_fn =         setup_t.O.oasis_fn;\n        oasis_version =    setup_t.O.oasis_version;\n        oasis_digest =     setup_t.O.oasis_digest;\n        oasis_exec =       setup_t.O.oasis_exec;\n        oasis_setup_args = setup_t.O.oasis_setup_args;\n        setup_update =     setup_t.O.setup_update;\n      }\n  end\n\n\n  module Compat_0_3 =\n  struct\n    include Compat_0_4\n  end\n\nend\n\n\n# 5662 \"setup.ml\"\nmodule InternalConfigurePlugin = struct\n(* # 22 \"src/plugins/internal/InternalConfigurePlugin.ml\" *)\n\n\n  (** Configure using internal scheme\n      @author Sylvain Le Gall\n  *)\n\n\n  open BaseEnv\n  open OASISTypes\n  open OASISUtils\n  open OASISGettext\n  open BaseMessage\n\n\n  (** Configure build using provided series of check to be done\n      and then output corresponding file.\n  *)\n  let configure ~ctxt:_ pkg argv =\n    let var_ignore_eval var = let _s: string = var () in () in\n    let errors = ref SetString.empty in\n    let buff = Buffer.create 13 in\n\n    let add_errors fmt =\n      Printf.kbprintf\n        (fun b ->\n           errors := SetString.add (Buffer.contents b) !errors;\n           Buffer.clear b)\n        buff\n        fmt\n    in\n\n    let warn_exception e =\n      warning \"%s\" (Printexc.to_string e)\n    in\n\n    (* Check tools *)\n    let check_tools lst =\n      List.iter\n        (function\n          | ExternalTool tool ->\n            begin\n              try\n                var_ignore_eval (BaseCheck.prog tool)\n              with e ->\n                warn_exception e;\n                add_errors (f_ \"Cannot find external tool '%s'\") tool\n            end\n          | InternalExecutable nm1 ->\n            (* Check that matching tool is built *)\n            List.iter\n              (function\n                | Executable ({cs_name = nm2; _},\n                              {bs_build = build; _},\n                    _) when nm1 = nm2 ->\n                  if not (var_choose build) then\n                    add_errors\n                      (f_ \"Cannot find buildable internal executable \\\n                           '%s' when checking build depends\")\n                      nm1\n                | _ ->\n                  ())\n              pkg.sections)\n        lst\n    in\n\n    let build_checks sct bs =\n      if var_choose bs.bs_build then\n        begin\n          if bs.bs_compiled_object = Native then\n            begin\n              try\n                var_ignore_eval BaseStandardVar.ocamlopt\n              with e ->\n                warn_exception e;\n                add_errors\n                  (f_ \"Section %s requires native compilation\")\n                  (OASISSection.string_of_section sct)\n            end;\n\n          (* Check tools *)\n          check_tools bs.bs_build_tools;\n\n          (* Check depends *)\n          List.iter\n            (function\n              | FindlibPackage (findlib_pkg, version_comparator) ->\n                begin\n                  try\n                    var_ignore_eval\n                      (BaseCheck.package ?version_comparator findlib_pkg)\n                  with e ->\n                    warn_exception e;\n                    match version_comparator with\n                      | None ->\n                        add_errors\n                          (f_ \"Cannot find findlib package %s\")\n                          findlib_pkg\n                      | Some ver_cmp ->\n                        add_errors\n                          (f_ \"Cannot find findlib package %s (%s)\")\n                          findlib_pkg\n                          (OASISVersion.string_of_comparator ver_cmp)\n                end\n              | InternalLibrary nm1 ->\n                (* Check that matching library is built *)\n                List.iter\n                  (function\n                    | Library ({cs_name = nm2; _},\n                               {bs_build = build; _},\n                        _) when nm1 = nm2 ->\n                      if not (var_choose build) then\n                        add_errors\n                          (f_ \"Cannot find buildable internal library \\\n                               '%s' when checking build depends\")\n                          nm1\n                    | _ ->\n                      ())\n                  pkg.sections)\n            bs.bs_build_depends\n        end\n    in\n\n    (* Parse command line *)\n    BaseArgExt.parse argv (BaseEnv.args ());\n\n    (* OCaml version *)\n    begin\n      match pkg.ocaml_version with\n        | Some ver_cmp ->\n          begin\n            try\n              var_ignore_eval\n                (BaseCheck.version\n                   \"ocaml\"\n                   ver_cmp\n                   BaseStandardVar.ocaml_version)\n            with e ->\n              warn_exception e;\n              add_errors\n                (f_ \"OCaml version %s doesn't match version constraint %s\")\n                (BaseStandardVar.ocaml_version ())\n                (OASISVersion.string_of_comparator ver_cmp)\n          end\n        | None ->\n          ()\n    end;\n\n    (* Findlib version *)\n    begin\n      match pkg.findlib_version with\n        | Some ver_cmp ->\n          begin\n            try\n              var_ignore_eval\n                (BaseCheck.version\n                   \"findlib\"\n                   ver_cmp\n                   BaseStandardVar.findlib_version)\n            with e ->\n              warn_exception e;\n              add_errors\n                (f_ \"Findlib version %s doesn't match version constraint %s\")\n                (BaseStandardVar.findlib_version ())\n                (OASISVersion.string_of_comparator ver_cmp)\n          end\n        | None ->\n          ()\n    end;\n    (* Make sure the findlib version is fine for the OCaml compiler. *)\n    begin\n      let ocaml_ge4 =\n        OASISVersion.version_compare\n          (OASISVersion.version_of_string (BaseStandardVar.ocaml_version ()))\n          (OASISVersion.version_of_string \"4.0.0\") >= 0 in\n      if ocaml_ge4 then\n        let findlib_lt132 =\n          OASISVersion.version_compare\n            (OASISVersion.version_of_string (BaseStandardVar.findlib_version()))\n            (OASISVersion.version_of_string \"1.3.2\") < 0 in\n        if findlib_lt132 then\n          add_errors \"OCaml >= 4.0.0 requires Findlib version >= 1.3.2\"\n    end;\n\n    (* FlexDLL *)\n    if BaseStandardVar.os_type () = \"Win32\" ||\n       BaseStandardVar.os_type () = \"Cygwin\" then\n      begin\n        try\n          var_ignore_eval BaseStandardVar.flexlink\n        with e ->\n          warn_exception e;\n          add_errors (f_ \"Cannot find 'flexlink'\")\n      end;\n\n    (* Check build depends *)\n    List.iter\n      (function\n        | Executable (_, bs, _)\n        | Library (_, bs, _) as sct ->\n          build_checks sct bs\n        | Doc (_, doc) ->\n          if var_choose doc.doc_build then\n            check_tools doc.doc_build_tools\n        | Test (_, test) ->\n          if var_choose test.test_run then\n            check_tools test.test_tools\n        | _ ->\n          ())\n      pkg.sections;\n\n    (* Check if we need native dynlink (presence of libraries that compile to\n       native)\n    *)\n    begin\n      let has_cmxa =\n        List.exists\n          (function\n            | Library (_, bs, _) ->\n              var_choose bs.bs_build &&\n              (bs.bs_compiled_object = Native ||\n               (bs.bs_compiled_object = Best &&\n                bool_of_string (BaseStandardVar.is_native ())))\n            | _  ->\n              false)\n          pkg.sections\n      in\n      if has_cmxa then\n        var_ignore_eval BaseStandardVar.native_dynlink\n    end;\n\n    (* Check errors *)\n    if SetString.empty != !errors then\n      begin\n        List.iter\n          (fun e -> error \"%s\" e)\n          (SetString.elements !errors);\n        failwithf\n          (fn_\n             \"%d configuration error\"\n             \"%d configuration errors\"\n             (SetString.cardinal !errors))\n          (SetString.cardinal !errors)\n      end\n\n\nend\n\nmodule InternalInstallPlugin = struct\n(* # 22 \"src/plugins/internal/InternalInstallPlugin.ml\" *)\n\n\n  (** Install using internal scheme\n      @author Sylvain Le Gall\n    *)\n\n\n  (* TODO: rewrite this module with OASISFileSystem. *)\n\n  open BaseEnv\n  open BaseStandardVar\n  open BaseMessage\n  open OASISTypes\n  open OASISFindlib\n  open OASISGettext\n  open OASISUtils\n\n\n  let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec)\n  let lib_hook  = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, [])\n  let obj_hook  = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, [])\n  let doc_hook  = ref (fun (cs, doc) -> cs, doc)\n\n  let install_file_ev    = \"install-file\"\n  let install_dir_ev     = \"install-dir\"\n  let install_findlib_ev = \"install-findlib\"\n\n\n  (* TODO: this can be more generic and used elsewhere. *)\n  let win32_max_command_line_length = 8000\n\n\n  let split_install_command ocamlfind findlib_name meta files =\n    if Sys.os_type = \"Win32\" then\n      (* Arguments for the first command: *)\n      let first_args = [\"install\"; findlib_name; meta] in\n      (* Arguments for remaining commands: *)\n      let other_args = [\"install\"; findlib_name; \"-add\"] in\n      (* Extract as much files as possible from [files], [len] is\n         the current command line length: *)\n      let rec get_files len acc files =\n        match files with\n          | [] ->\n              (List.rev acc, [])\n          | file :: rest ->\n              let len = len + 1 + String.length file in\n              if len > win32_max_command_line_length then\n                (List.rev acc, files)\n              else\n                get_files len (file :: acc) rest\n      in\n      (* Split the command into several commands. *)\n      let rec split args files =\n        match files with\n          | [] ->\n              []\n          | _ ->\n              (* Length of \"ocamlfind install <lib> [META|-add]\" *)\n              let len =\n                List.fold_left\n                  (fun len arg ->\n                     len + 1 (* for the space *) + String.length arg)\n                  (String.length ocamlfind)\n                  args\n              in\n              match get_files len [] files with\n                | ([], _) ->\n                    failwith (s_ \"Command line too long.\")\n                | (firsts, others) ->\n                    let cmd = args @ firsts in\n                    (* Use -add for remaining commands: *)\n                    let () =\n                      let findlib_ge_132 =\n                        OASISVersion.comparator_apply\n                          (OASISVersion.version_of_string\n                             (BaseStandardVar.findlib_version ()))\n                          (OASISVersion.VGreaterEqual\n                             (OASISVersion.version_of_string \"1.3.2\"))\n                      in\n                        if not findlib_ge_132 then\n                          failwithf\n                            (f_ \"Installing the library %s require to use the \\\n                                 flag '-add' of ocamlfind because the command \\\n                                 line is too long. This flag is only available \\\n                                 for findlib 1.3.2. Please upgrade findlib from \\\n                                 %s to 1.3.2\")\n                            findlib_name (BaseStandardVar.findlib_version ())\n                    in\n                    let cmds = split other_args others in\n                    cmd :: cmds\n      in\n      (* The first command does not use -add: *)\n      split first_args files\n    else\n      [\"install\" :: findlib_name :: meta :: files]\n\n\n  let install =\n\n    let in_destdir fn =\n      try\n        (* Practically speaking destdir is prepended at the beginning of the\n           target filename\n        *)\n        (destdir ())^fn\n      with PropList.Not_set _ ->\n        fn\n    in\n\n    let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =\n      let tgt_dir =\n        if prepend_destdir then in_destdir (envdir ()) else envdir ()\n      in\n      let tgt_file =\n        Filename.concat\n          tgt_dir\n          (match tgt_fn with\n             | Some fn ->\n                 fn\n             | None ->\n                 Filename.basename src_file)\n      in\n        (* Create target directory if needed *)\n        OASISFileUtil.mkdir_parent\n          ~ctxt\n          (fun dn ->\n             info (f_ \"Creating directory '%s'\") dn;\n             BaseLog.register ~ctxt install_dir_ev dn)\n          (Filename.dirname tgt_file);\n\n        (* Really install files *)\n        info (f_ \"Copying file '%s' to '%s'\") src_file tgt_file;\n        OASISFileUtil.cp ~ctxt src_file tgt_file;\n        BaseLog.register ~ctxt install_file_ev tgt_file\n    in\n\n    (* Install the files for a library. *)\n\n    let install_lib_files ~ctxt findlib_name files =\n      let findlib_dir =\n        let dn =\n          let findlib_destdir =\n            OASISExec.run_read_one_line ~ctxt (ocamlfind ())\n              [\"printconf\" ; \"destdir\"]\n          in\n          Filename.concat findlib_destdir findlib_name\n        in\n        fun () -> dn\n      in\n      let () =\n        if not (OASISFileUtil.file_exists_case (findlib_dir ())) then\n          failwithf\n            (f_ \"Directory '%s' doesn't exist for findlib library %s\")\n            (findlib_dir ()) findlib_name\n      in\n      let f dir file =\n        let basename = Filename.basename file in\n        let tgt_fn = Filename.concat dir basename in\n        (* Destdir is already include in printconf. *)\n        install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir\n      in\n      List.iter (fun (dir, files) -> List.iter (f dir) files) files ;\n    in\n\n    (* Install data into defined directory *)\n    let install_data ~ctxt srcdir lst tgtdir =\n      let tgtdir =\n        OASISHostPath.of_unix (var_expand tgtdir)\n      in\n        List.iter\n          (fun (src, tgt_opt) ->\n             let real_srcs =\n               OASISFileUtil.glob\n                 ~ctxt:!BaseContext.default\n                 (Filename.concat srcdir src)\n             in\n               if real_srcs = [] then\n                 failwithf\n                   (f_ \"Wildcard '%s' doesn't match any files\")\n                   src;\n               List.iter\n                 (fun fn ->\n                    install_file ~ctxt\n                      fn\n                      (fun () ->\n                         match tgt_opt with\n                           | Some s ->\n                               OASISHostPath.of_unix (var_expand s)\n                           | None ->\n                               tgtdir))\n                 real_srcs)\n          lst\n    in\n\n    let make_fnames modul sufx =\n      List.fold_right\n        begin fun sufx accu ->\n          (OASISString.capitalize_ascii modul ^ sufx) ::\n          (OASISString.uncapitalize_ascii modul ^ sufx) ::\n          accu\n        end\n        sufx\n        []\n    in\n\n    (** Install all libraries *)\n    let install_libs ~ctxt pkg =\n\n      let find_first_existing_files_in_path bs lst =\n        let path = OASISHostPath.of_unix bs.bs_path in\n        List.find\n          OASISFileUtil.file_exists_case\n          (List.map (Filename.concat path) lst)\n      in\n\n      let files_of_modules new_files typ cs bs modules =\n        List.fold_left\n          (fun acc modul ->\n             begin\n               try\n                 (* Add uncompiled header from the source tree *)\n                 [find_first_existing_files_in_path\n                    bs (make_fnames modul [\".mli\"; \".ml\"])]\n               with Not_found ->\n                 warning\n                   (f_ \"Cannot find source header for module %s \\\n                        in %s %s\")\n                   typ modul cs.cs_name;\n                 []\n             end\n             @\n             List.fold_left\n               (fun acc fn ->\n                  try\n                    find_first_existing_files_in_path bs [fn] :: acc\n                  with Not_found ->\n                    acc)\n               acc (make_fnames modul [\".annot\";\".cmti\";\".cmt\"]))\n          new_files\n          modules\n      in\n\n      let files_of_build_section (f_data, new_files) typ cs bs =\n        let extra_files =\n          List.map\n            (fun fn ->\n               try\n                 find_first_existing_files_in_path bs [fn]\n               with Not_found ->\n                 failwithf\n                   (f_ \"Cannot find extra findlib file %S in %s %s \")\n                   fn\n                   typ\n                   cs.cs_name)\n            bs.bs_findlib_extra_files\n        in\n        let f_data () =\n          (* Install data associated with the library *)\n          install_data\n            ~ctxt\n            bs.bs_path\n            bs.bs_data_files\n            (Filename.concat\n               (datarootdir ())\n               pkg.name);\n          f_data ()\n        in\n        f_data, new_files @ extra_files\n      in\n\n      let files_of_library (f_data, acc) data_lib =\n        let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in\n        if var_choose bs.bs_install &&\n           BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin\n          (* Start with lib_extra *)\n          let new_files = lib_extra in\n          let new_files =\n            files_of_modules new_files \"library\" cs bs lib.lib_modules\n          in\n          let f_data, new_files =\n            files_of_build_section (f_data, new_files) \"library\" cs bs\n          in\n          let new_files =\n            (* Get generated files *)\n            BaseBuilt.fold\n              ~ctxt\n              BaseBuilt.BLib\n              cs.cs_name\n              (fun acc fn -> fn :: acc)\n              new_files\n          in\n          let acc = (dn, new_files) :: acc in\n\n          let f_data () =\n            (* Install data associated with the library *)\n            install_data\n              ~ctxt\n              bs.bs_path\n              bs.bs_data_files\n              (Filename.concat\n                 (datarootdir ())\n                 pkg.name);\n            f_data ()\n          in\n\n          (f_data, acc)\n        end else begin\n          (f_data, acc)\n        end\n      and files_of_object (f_data, acc) data_obj =\n        let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in\n        if var_choose bs.bs_install &&\n           BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin\n          (* Start with obj_extra *)\n          let new_files = obj_extra in\n          let new_files =\n            files_of_modules new_files \"object\" cs bs obj.obj_modules\n          in\n          let f_data, new_files =\n            files_of_build_section (f_data, new_files) \"object\" cs bs\n          in\n\n          let new_files =\n            (* Get generated files *)\n            BaseBuilt.fold\n              ~ctxt\n              BaseBuilt.BObj\n              cs.cs_name\n              (fun acc fn -> fn :: acc)\n              new_files\n          in\n          let acc = (dn, new_files) :: acc in\n\n          let f_data () =\n            (* Install data associated with the object *)\n            install_data\n              ~ctxt\n              bs.bs_path\n              bs.bs_data_files\n              (Filename.concat (datarootdir ()) pkg.name);\n            f_data ()\n          in\n          (f_data, acc)\n        end else begin\n          (f_data, acc)\n        end\n      in\n\n      (* Install one group of library *)\n      let install_group_lib grp =\n        (* Iterate through all group nodes *)\n        let rec install_group_lib_aux data_and_files grp =\n          let data_and_files, children =\n            match grp with\n              | Container (_, children) ->\n                  data_and_files, children\n              | Package (_, cs, bs, `Library lib, dn, children) ->\n                  files_of_library data_and_files (cs, bs, lib, dn), children\n              | Package (_, cs, bs, `Object obj, dn, children) ->\n                  files_of_object data_and_files (cs, bs, obj, dn), children\n          in\n            List.fold_left\n              install_group_lib_aux\n              data_and_files\n              children\n        in\n\n        (* Findlib name of the root library *)\n        let findlib_name = findlib_of_group grp in\n\n        (* Determine root library *)\n        let root_lib = root_of_group grp in\n\n        (* All files to install for this library *)\n        let f_data, files = install_group_lib_aux (ignore, []) grp in\n\n          (* Really install, if there is something to install *)\n        if files = [] then begin\n          warning\n            (f_ \"Nothing to install for findlib library '%s'\") findlib_name\n        end else begin\n          let meta =\n            (* Search META file *)\n            let _, bs, _ = root_lib in\n            let res = Filename.concat bs.bs_path \"META\" in\n            if not (OASISFileUtil.file_exists_case res) then\n              failwithf\n                (f_ \"Cannot find file '%s' for findlib library %s\")\n                res\n                findlib_name;\n            res\n          in\n          let files =\n            (* Make filename shorter to avoid hitting command max line length\n             * too early, esp. on Windows.\n            *)\n            (* TODO: move to OASISHostPath as make_relative. *)\n            let remove_prefix p n =\n              let plen = String.length p in\n              let nlen = String.length n in\n              if plen <= nlen && String.sub n 0 plen = p then begin\n                let fn_sep = if Sys.os_type = \"Win32\" then '\\\\' else '/' in\n                let cutpoint =\n                  plen +\n                  (if plen < nlen && n.[plen] = fn_sep then 1 else 0)\n                in\n                String.sub n cutpoint (nlen - cutpoint)\n              end else begin\n                n\n              end\n            in\n            List.map\n              (fun (dir, fn) ->\n                 (dir, List.map (remove_prefix (Sys.getcwd ())) fn))\n              files\n          in\n          let ocamlfind = ocamlfind () in\n          let nodir_files, dir_files =\n            List.fold_left\n              (fun (nodir, dir) (dn, lst) ->\n                 match dn with\n                 | Some dn -> nodir, (dn, lst) :: dir\n                 | None -> lst @ nodir, dir)\n              ([], [])\n              (List.rev files)\n          in\n          info (f_ \"Installing findlib library '%s'\") findlib_name;\n          List.iter\n            (OASISExec.run ~ctxt ocamlfind)\n            (split_install_command ocamlfind findlib_name meta nodir_files);\n          install_lib_files ~ctxt findlib_name dir_files;\n          BaseLog.register ~ctxt install_findlib_ev findlib_name\n        end;\n\n        (* Install data files *)\n        f_data ();\n      in\n\n      let group_libs, _, _ = findlib_mapping pkg in\n\n        (* We install libraries in groups *)\n        List.iter install_group_lib group_libs\n    in\n\n    let install_execs ~ctxt pkg =\n      let install_exec data_exec =\n        let cs, bs, _ = !exec_hook data_exec in\n        if var_choose bs.bs_install &&\n           BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin\n          let exec_libdir () = Filename.concat (libdir ()) pkg.name in\n          BaseBuilt.fold\n            ~ctxt\n            BaseBuilt.BExec\n            cs.cs_name\n            (fun () fn ->\n               install_file ~ctxt\n                 ~tgt_fn:(cs.cs_name ^ ext_program ())\n                 fn\n                 bindir)\n            ();\n          BaseBuilt.fold\n            ~ctxt\n            BaseBuilt.BExecLib\n            cs.cs_name\n            (fun () fn -> install_file ~ctxt fn exec_libdir)\n            ();\n          install_data ~ctxt\n            bs.bs_path\n            bs.bs_data_files\n            (Filename.concat (datarootdir ()) pkg.name)\n        end\n      in\n      List.iter\n        (function\n          | Executable (cs, bs, exec)-> install_exec (cs, bs, exec)\n          | _ -> ())\n          pkg.sections\n    in\n\n    let install_docs ~ctxt pkg =\n      let install_doc data =\n        let cs, doc = !doc_hook data in\n        if var_choose doc.doc_install &&\n           BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin\n          let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in\n          BaseBuilt.fold\n            ~ctxt\n            BaseBuilt.BDoc\n            cs.cs_name\n            (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir))\n            ();\n          install_data ~ctxt\n            Filename.current_dir_name\n            doc.doc_data_files\n            doc.doc_install_dir\n        end\n      in\n      List.iter\n        (function\n          | Doc (cs, doc) -> install_doc (cs, doc)\n          | _ -> ())\n        pkg.sections\n    in\n    fun ~ctxt pkg _ ->\n      install_libs ~ctxt pkg;\n      install_execs ~ctxt pkg;\n      install_docs ~ctxt pkg\n\n\n  (* Uninstall already installed data *)\n  let uninstall ~ctxt _ _ =\n    let uninstall_aux (ev, data) =\n      if ev = install_file_ev then begin\n        if OASISFileUtil.file_exists_case data then begin\n          info (f_ \"Removing file '%s'\") data;\n          Sys.remove data\n        end else begin\n          warning (f_ \"File '%s' doesn't exist anymore\") data\n        end\n      end else if ev = install_dir_ev then begin\n        if Sys.file_exists data && Sys.is_directory data then begin\n          if Sys.readdir data = [||] then begin\n            info (f_ \"Removing directory '%s'\") data;\n            OASISFileUtil.rmdir ~ctxt data\n          end else begin\n            warning\n              (f_ \"Directory '%s' is not empty (%s)\")\n              data\n              (String.concat \", \" (Array.to_list (Sys.readdir data)))\n          end\n        end else begin\n          warning (f_ \"Directory '%s' doesn't exist anymore\") data\n        end\n      end else if ev = install_findlib_ev then begin\n        info (f_ \"Removing findlib library '%s'\") data;\n        OASISExec.run ~ctxt (ocamlfind ()) [\"remove\"; data]\n      end else begin\n        failwithf (f_ \"Unknown log event '%s'\") ev;\n      end;\n      BaseLog.unregister ~ctxt ev data\n    in\n    (* We process event in reverse order *)\n    List.iter uninstall_aux\n      (List.rev\n         (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev]));\n    List.iter uninstall_aux\n      (List.rev (BaseLog.filter ~ctxt [install_findlib_ev]))\n\nend\n\n\n# 6465 \"setup.ml\"\nmodule OCamlbuildCommon = struct\n(* # 22 \"src/plugins/ocamlbuild/OCamlbuildCommon.ml\" *)\n\n\n  (** Functions common to OCamlbuild build and doc plugin\n  *)\n\n\n  open OASISGettext\n  open BaseEnv\n  open BaseStandardVar\n  open OASISTypes\n\n\n  type extra_args = string list\n\n\n  let ocamlbuild_clean_ev = \"ocamlbuild-clean\"\n\n\n  let ocamlbuildflags =\n    var_define\n      ~short_desc:(fun () -> \"OCamlbuild additional flags\")\n      \"ocamlbuildflags\"\n      (fun () -> \"\")\n\n\n  (** Fix special arguments depending on environment *)\n  let fix_args args extra_argv =\n    List.flatten\n      [\n        if (os_type ()) = \"Win32\" then\n          [\n            \"-classic-display\";\n            \"-no-log\";\n            \"-no-links\";\n          ]\n        else\n          [];\n\n        if OASISVersion.comparator_apply\n            (OASISVersion.version_of_string (ocaml_version ()))\n            (OASISVersion.VLesser (OASISVersion.version_of_string \"3.11.1\")) then\n          [\n            \"-install-lib-dir\";\n            (Filename.concat (standard_library ()) \"ocamlbuild\")\n          ]\n        else\n          [];\n\n        if not (bool_of_string (is_native ())) || (os_type ()) = \"Win32\" then\n          [\n            \"-byte-plugin\"\n          ]\n        else\n          [];\n        args;\n\n        if bool_of_string (debug ()) then\n          [\"-tag\"; \"debug\"]\n        else\n          [];\n\n        if bool_of_string (tests ()) then\n          [\"-tag\"; \"tests\"]\n        else\n          [];\n\n        if bool_of_string (profile ()) then\n          [\"-tag\"; \"profile\"]\n        else\n          [];\n\n        OASISString.nsplit (ocamlbuildflags ()) ' ';\n\n        Array.to_list extra_argv;\n      ]\n\n\n  (** Run 'ocamlbuild -clean' if not already done *)\n  let run_clean ~ctxt extra_argv =\n    let extra_cli =\n      String.concat \" \" (Array.to_list extra_argv)\n    in\n    (* Run if never called with these args *)\n    if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then\n      begin\n        OASISExec.run ~ctxt (ocamlbuild ()) (fix_args [\"-clean\"] extra_argv);\n        BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli;\n        at_exit\n          (fun () ->\n             try\n               BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli\n             with _ -> ())\n      end\n\n\n  (** Run ocamlbuild, unregister all clean events *)\n  let run_ocamlbuild ~ctxt args extra_argv =\n    (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html\n    *)\n    OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv);\n    (* Remove any clean event, we must run it again *)\n    List.iter\n      (fun (e, d) -> BaseLog.unregister ~ctxt e d)\n      (BaseLog.filter ~ctxt [ocamlbuild_clean_ev])\n\n\n  (** Determine real build directory *)\n  let build_dir extra_argv =\n    let rec search_args dir =\n      function\n        | \"-build-dir\" :: dir :: tl ->\n          search_args dir tl\n        | _ :: tl ->\n          search_args dir tl\n        | [] ->\n          dir\n    in\n    search_args \"_build\" (fix_args [] extra_argv)\n\n\nend\n\nmodule OCamlbuildPlugin = struct\n(* # 22 \"src/plugins/ocamlbuild/OCamlbuildPlugin.ml\" *)\n\n\n  (** Build using ocamlbuild\n      @author Sylvain Le Gall\n    *)\n\n\n  open OASISTypes\n  open OASISGettext\n  open OASISUtils\n  open OASISString\n  open BaseEnv\n  open OCamlbuildCommon\n  open BaseStandardVar\n\n\n  let cond_targets_hook = ref (fun lst -> lst)\n\n\n  let build ~ctxt extra_args pkg argv =\n    (* Return the filename in build directory *)\n    let in_build_dir fn =\n      Filename.concat\n        (build_dir argv)\n        fn\n    in\n\n    (* Return the unix filename in host build directory *)\n    let in_build_dir_of_unix fn =\n      in_build_dir (OASISHostPath.of_unix fn)\n    in\n\n    let cond_targets =\n      List.fold_left\n        (fun acc ->\n           function\n             | Library (cs, bs, lib) when var_choose bs.bs_build ->\n                 begin\n                   let evs, unix_files =\n                     BaseBuilt.of_library\n                       in_build_dir_of_unix\n                       (cs, bs, lib)\n                   in\n\n                   let tgts =\n                     List.flatten\n                       (List.filter\n                          (fun l -> l <> [])\n                          (List.map\n                             (List.filter\n                                (fun fn ->\n                                 ends_with ~what:\".cma\" fn\n                                 || ends_with ~what:\".cmxs\" fn\n                                 || ends_with ~what:\".cmxa\" fn\n                                 || ends_with ~what:(ext_lib ()) fn\n                                 || ends_with ~what:(ext_dll ()) fn))\n                             unix_files))\n                   in\n\n                     match tgts with\n                       | _ :: _ ->\n                           (evs, tgts) :: acc\n                       | [] ->\n                           failwithf\n                             (f_ \"No possible ocamlbuild targets for library %s\")\n                             cs.cs_name\n                 end\n\n             | Object (cs, bs, obj) when var_choose bs.bs_build ->\n                 begin\n                   let evs, unix_files =\n                     BaseBuilt.of_object\n                       in_build_dir_of_unix\n                       (cs, bs, obj)\n                   in\n\n                   let tgts =\n                     List.flatten\n                       (List.filter\n                          (fun l -> l <> [])\n                          (List.map\n                             (List.filter\n                                (fun fn ->\n                                 ends_with ~what:\".cmo\" fn\n                                 || ends_with ~what:\".cmx\" fn))\n                             unix_files))\n                   in\n\n                     match tgts with\n                       | _ :: _ ->\n                           (evs, tgts) :: acc\n                       | [] ->\n                           failwithf\n                             (f_ \"No possible ocamlbuild targets for object %s\")\n                             cs.cs_name\n                 end\n\n             | Executable (cs, bs, exec) when var_choose bs.bs_build ->\n                 begin\n                   let evs, _, _ =\n                     BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec)\n                   in\n\n                   let target ext =\n                     let unix_tgt =\n                       (OASISUnixPath.concat\n                          bs.bs_path\n                          (OASISUnixPath.chop_extension\n                             exec.exec_main_is))^ext\n                     in\n                     let evs =\n                       (* Fix evs, we want to use the unix_tgt, without copying *)\n                       List.map\n                         (function\n                            | BaseBuilt.BExec, nm, _ when nm = cs.cs_name ->\n                                BaseBuilt.BExec, nm,\n                                [[in_build_dir_of_unix unix_tgt]]\n                            | ev ->\n                                ev)\n                         evs\n                     in\n                       evs, [unix_tgt]\n                   in\n\n                   (* Add executable *)\n                   let acc =\n                     match bs.bs_compiled_object with\n                       | Native ->\n                           (target \".native\") :: acc\n                       | Best when bool_of_string (is_native ()) ->\n                           (target \".native\") :: acc\n                       | Byte\n                       | Best ->\n                           (target \".byte\") :: acc\n                   in\n                     acc\n                 end\n\n             | Library _ | Object _ | Executable _ | Test _\n             | SrcRepo _ | Flag _ | Doc _ ->\n                 acc)\n        []\n        (* Keep the pkg.sections ordered *)\n        (List.rev pkg.sections);\n    in\n\n    (* Check and register built files *)\n    let check_and_register (bt, bnm, lst) =\n      List.iter\n        (fun fns ->\n           if not (List.exists OASISFileUtil.file_exists_case fns) then\n             failwithf\n               (fn_\n                  \"Expected built file %s doesn't exist.\"\n                  \"None of expected built files %s exists.\"\n                  (List.length fns))\n               (String.concat (s_ \" or \") (List.map (Printf.sprintf \"'%s'\") fns)))\n        lst;\n        (BaseBuilt.register ~ctxt bt bnm lst)\n    in\n\n    (* Run the hook *)\n    let cond_targets = !cond_targets_hook cond_targets in\n\n    (* Run a list of target... *)\n    run_ocamlbuild\n      ~ctxt\n      (List.flatten (List.map snd cond_targets) @ extra_args)\n      argv;\n    (* ... and register events *)\n    List.iter check_and_register (List.flatten (List.map fst cond_targets))\n\n\n  let clean ~ctxt pkg extra_args  =\n    run_clean ~ctxt extra_args;\n    List.iter\n      (function\n         | Library (cs, _, _) ->\n             BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name\n         | Executable (cs, _, _) ->\n             BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;\n             BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name\n         | _ ->\n             ())\n      pkg.sections\n\n\nend\n\nmodule OCamlbuildDocPlugin = struct\n(* # 22 \"src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml\" *)\n\n\n  (* Create documentation using ocamlbuild .odocl files\n     @author Sylvain Le Gall\n  *)\n\n\n  open OASISTypes\n  open OASISGettext\n  open OCamlbuildCommon\n\n\n  type run_t =\n    {\n      extra_args: string list;\n      run_path: unix_filename;\n    }\n\n\n  let doc_build ~ctxt run _ (cs, _) argv =\n    let index_html =\n      OASISUnixPath.make\n        [\n          run.run_path;\n          cs.cs_name^\".docdir\";\n          \"index.html\";\n        ]\n    in\n    let tgt_dir =\n      OASISHostPath.make\n        [\n          build_dir argv;\n          OASISHostPath.of_unix run.run_path;\n          cs.cs_name^\".docdir\";\n        ]\n    in\n    run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv;\n    List.iter\n      (fun glb ->\n         match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with\n         | (_ :: _) as filenames ->\n             BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames]\n         | [] -> ())\n      [\"*.html\"; \"*.css\"]\n\n\n  let doc_clean ~ctxt _ _ (cs, _) argv =\n    run_clean ~ctxt argv;\n    BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name\n\n\nend\n\n\n# 6837 \"setup.ml\"\nopen OASISTypes;;\n\nlet setup_t =\n  {\n     BaseSetup.configure = InternalConfigurePlugin.configure;\n     build = OCamlbuildPlugin.build [];\n     test = [];\n     doc = [];\n     install = InternalInstallPlugin.install;\n     uninstall = InternalInstallPlugin.uninstall;\n     clean = [OCamlbuildPlugin.clean];\n     clean_test = [];\n     clean_doc = [];\n     distclean = [];\n     distclean_test = [];\n     distclean_doc = [];\n     package =\n       {\n          oasis_version = \"0.4\";\n          ocaml_version = None;\n          version = \"0.0.03\";\n          license =\n            OASISLicense.DEP5License\n              (OASISLicense.DEP5Unit\n                 {\n                    OASISLicense.license = \"Apache\";\n                    excption = None;\n                    version = OASISLicense.Version \"2.0\"\n                 });\n          findlib_version = None;\n          alpha_features = [];\n          beta_features = [];\n          name = \"bamboo\";\n          license_file = None;\n          copyrights = [];\n          maintainers = [];\n          authors = [\"Yoichi Hirai <i@yoichihirai.com>\"];\n          homepage = Some \"https://github.com/pirapira/bamboo\";\n          bugreports = None;\n          synopsis = \"A compiler targeting Ethereum Virtual Machine\";\n          description =\n            Some\n              [\n                 OASISText.Para\n                   \"Bamboo compiles a simple language to Ethereum Virtual Machine. The language is designed to keep programmers away from common mistakes. It features: state transition as recursion with potentially changing arguments, mandatory reentrance continuation when calling out, no loops, no assignments except to mappings and partial compliance with common Ethereum ABI.\"\n              ];\n          tags = [];\n          categories = [];\n          files_ab = [];\n          sections =\n            [\n               SrcRepo\n                 ({\n                     cs_name = \"opam-pin\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      src_repo_type = Git;\n                      src_repo_location =\n                        \"https://github.com/pirapira/bamboo.git\";\n                      src_repo_browser = None;\n                      src_repo_module = None;\n                      src_repo_branch = Some \"master\";\n                      src_repo_tag = None;\n                      src_repo_subdir = None\n                   });\n               Library\n                 ({\n                     cs_name = \"cross-platform\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      bs_build = [(OASISExpr.EBool true, true)];\n                      bs_install = [(OASISExpr.EBool true, false)];\n                      bs_path = \"src/cross-platform-for-ocamlbuild\";\n                      bs_compiled_object = Best;\n                      bs_build_depends =\n                        [\n                           FindlibPackage (\"batteries\", None);\n                           FindlibPackage (\"rope\", None);\n                           FindlibPackage\n                             (\"cryptokit\",\n                               Some (OASISVersion.VGreaterEqual \"1.12\"));\n                           FindlibPackage (\"hex\", None)\n                        ];\n                      bs_build_tools = [ExternalTool \"ocamlbuild\"];\n                      bs_interface_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${capitalize_file module}.mli\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mli\"\n                           }\n                        ];\n                      bs_implementation_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${capitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${uncapitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${capitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${capitalize_file module}.mly\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mly\"\n                           }\n                        ];\n                      bs_c_sources = [];\n                      bs_data_files = [];\n                      bs_findlib_extra_files = [];\n                      bs_ccopt = [(OASISExpr.EBool true, [])];\n                      bs_cclib = [(OASISExpr.EBool true, [])];\n                      bs_dlllib = [(OASISExpr.EBool true, [])];\n                      bs_dllpath = [(OASISExpr.EBool true, [])];\n                      bs_byteopt = [(OASISExpr.EBool true, [])];\n                      bs_nativeopt = [(OASISExpr.EBool true, [])]\n                   },\n                   {\n                      lib_modules =\n                        [\n                           \"WrapBn\";\n                           \"WrapCryptokit\";\n                           \"WrapList\";\n                           \"WrapString\";\n                           \"WrapOption\"\n                        ];\n                      lib_pack = false;\n                      lib_internal_modules = [];\n                      lib_findlib_parent = None;\n                      lib_findlib_name = None;\n                      lib_findlib_directory = None;\n                      lib_findlib_containers = []\n                   });\n               Library\n                 ({\n                     cs_name = \"basics\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      bs_build = [(OASISExpr.EBool true, true)];\n                      bs_install = [(OASISExpr.EBool true, false)];\n                      bs_path = \"src/basics\";\n                      bs_compiled_object = Best;\n                      bs_build_depends = [InternalLibrary \"cross-platform\"];\n                      bs_build_tools = [ExternalTool \"ocamlbuild\"];\n                      bs_interface_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${capitalize_file module}.mli\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mli\"\n                           }\n                        ];\n                      bs_implementation_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${capitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${uncapitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${capitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${capitalize_file module}.mly\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mly\"\n                           }\n                        ];\n                      bs_c_sources = [];\n                      bs_data_files = [];\n                      bs_findlib_extra_files = [];\n                      bs_ccopt = [(OASISExpr.EBool true, [])];\n                      bs_cclib = [(OASISExpr.EBool true, [])];\n                      bs_dlllib = [(OASISExpr.EBool true, [])];\n                      bs_dllpath = [(OASISExpr.EBool true, [])];\n                      bs_byteopt = [(OASISExpr.EBool true, [])];\n                      bs_nativeopt = [(OASISExpr.EBool true, [])]\n                   },\n                   {\n                      lib_modules =\n                        [\"Assoc\"; \"Hexa\"; \"Label\"; \"Misc\"; \"Storage\"];\n                      lib_pack = false;\n                      lib_internal_modules = [];\n                      lib_findlib_parent = None;\n                      lib_findlib_name = None;\n                      lib_findlib_directory = None;\n                      lib_findlib_containers = []\n                   });\n               Library\n                 ({\n                     cs_name = \"ast\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      bs_build = [(OASISExpr.EBool true, true)];\n                      bs_install = [(OASISExpr.EBool true, false)];\n                      bs_path = \"src/ast\";\n                      bs_compiled_object = Best;\n                      bs_build_depends =\n                        [\n                           InternalLibrary \"basics\";\n                           FindlibPackage\n                             (\"cryptokit\",\n                               Some (OASISVersion.VGreaterEqual \"1.12\"));\n                           FindlibPackage (\"hex\", None)\n                        ];\n                      bs_build_tools = [ExternalTool \"ocamlbuild\"];\n                      bs_interface_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${capitalize_file module}.mli\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mli\"\n                           }\n                        ];\n                      bs_implementation_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${capitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${uncapitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${capitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${capitalize_file module}.mly\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mly\"\n                           }\n                        ];\n                      bs_c_sources = [];\n                      bs_data_files = [];\n                      bs_findlib_extra_files = [];\n                      bs_ccopt = [(OASISExpr.EBool true, [])];\n                      bs_cclib = [(OASISExpr.EBool true, [])];\n                      bs_dlllib = [(OASISExpr.EBool true, [])];\n                      bs_dllpath = [(OASISExpr.EBool true, [])];\n                      bs_byteopt = [(OASISExpr.EBool true, [])];\n                      bs_nativeopt = [(OASISExpr.EBool true, [])]\n                   },\n                   {\n                      lib_modules =\n                        [\n                           \"Contract\";\n                           \"Syntax\";\n                           \"TypeEnv\";\n                           \"Type\";\n                           \"PseudoImm\";\n                           \"Evm\";\n                           \"Location\";\n                           \"Ethereum\"\n                        ];\n                      lib_pack = false;\n                      lib_internal_modules = [];\n                      lib_findlib_parent = None;\n                      lib_findlib_name = None;\n                      lib_findlib_directory = None;\n                      lib_findlib_containers = []\n                   });\n               Library\n                 ({\n                     cs_name = \"parse\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      bs_build = [(OASISExpr.EBool true, true)];\n                      bs_install = [(OASISExpr.EBool true, false)];\n                      bs_path = \"src/parse\";\n                      bs_compiled_object = Best;\n                      bs_build_depends =\n                        [\n                           InternalLibrary \"ast\";\n                           FindlibPackage (\"menhirLib\", None)\n                        ];\n                      bs_build_tools = [ExternalTool \"ocamlbuild\"];\n                      bs_interface_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${capitalize_file module}.mli\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mli\"\n                           }\n                        ];\n                      bs_implementation_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${capitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${uncapitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${capitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${capitalize_file module}.mly\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mly\"\n                           }\n                        ];\n                      bs_c_sources = [];\n                      bs_data_files = [];\n                      bs_findlib_extra_files = [];\n                      bs_ccopt = [(OASISExpr.EBool true, [])];\n                      bs_cclib = [(OASISExpr.EBool true, [])];\n                      bs_dlllib = [(OASISExpr.EBool true, [])];\n                      bs_dllpath = [(OASISExpr.EBool true, [])];\n                      bs_byteopt = [(OASISExpr.EBool true, [])];\n                      bs_nativeopt = [(OASISExpr.EBool true, [])]\n                   },\n                   {\n                      lib_modules = [\"Lexer\"];\n                      lib_pack = false;\n                      lib_internal_modules = [];\n                      lib_findlib_parent = None;\n                      lib_findlib_name = None;\n                      lib_findlib_directory = None;\n                      lib_findlib_containers = []\n                   });\n               Library\n                 ({\n                     cs_name = \"codegen\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      bs_build = [(OASISExpr.EBool true, true)];\n                      bs_install = [(OASISExpr.EBool true, false)];\n                      bs_path = \"src/codegen\";\n                      bs_compiled_object = Best;\n                      bs_build_depends =\n                        [\n                           InternalLibrary \"basics\";\n                           InternalLibrary \"ast\";\n                           InternalLibrary \"parse\"\n                        ];\n                      bs_build_tools = [ExternalTool \"ocamlbuild\"];\n                      bs_interface_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${capitalize_file module}.mli\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mli\"\n                           }\n                        ];\n                      bs_implementation_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${capitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${uncapitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${capitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${capitalize_file module}.mly\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mly\"\n                           }\n                        ];\n                      bs_c_sources = [];\n                      bs_data_files = [];\n                      bs_findlib_extra_files = [];\n                      bs_ccopt = [(OASISExpr.EBool true, [])];\n                      bs_cclib = [(OASISExpr.EBool true, [])];\n                      bs_dlllib = [(OASISExpr.EBool true, [])];\n                      bs_dllpath = [(OASISExpr.EBool true, [])];\n                      bs_byteopt = [(OASISExpr.EBool true, [])];\n                      bs_nativeopt = [(OASISExpr.EBool true, [])]\n                   },\n                   {\n                      lib_modules =\n                        [\n                           \"CodegenEnv\";\n                           \"Codegen\";\n                           \"EntrypointDatabase\";\n                           \"LayoutInfo\";\n                           \"LocationEnv\";\n                           \"Parse\"\n                        ];\n                      lib_pack = false;\n                      lib_internal_modules = [];\n                      lib_findlib_parent = None;\n                      lib_findlib_name = None;\n                      lib_findlib_directory = None;\n                      lib_findlib_containers = []\n                   });\n               Executable\n                 ({\n                     cs_name = \"bamboo\";\n                     cs_data = PropList.Data.create ();\n                     cs_plugin_data = []\n                  },\n                   {\n                      bs_build = [(OASISExpr.EBool true, true)];\n                      bs_install = [(OASISExpr.EBool true, true)];\n                      bs_path = \"src/exec\";\n                      bs_compiled_object = Best;\n                      bs_build_depends =\n                        [InternalLibrary \"parse\"; InternalLibrary \"codegen\"];\n                      bs_build_tools = [ExternalTool \"ocamlbuild\"];\n                      bs_interface_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${capitalize_file module}.mli\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mli\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mli\"\n                           }\n                        ];\n                      bs_implementation_patterns =\n                        [\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${capitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".ml\"\n                                ];\n                              origin = \"${uncapitalize_file module}.ml\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${capitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mll\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mll\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"capitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${capitalize_file module}.mly\"\n                           };\n                           {\n                              OASISSourcePatterns.Templater.atoms =\n                                [\n                                   OASISSourcePatterns.Templater.Text \"\";\n                                   OASISSourcePatterns.Templater.Expr\n                                     (OASISSourcePatterns.Templater.Call\n                                        (\"uncapitalize_file\",\n                                          OASISSourcePatterns.Templater.Ident\n                                            \"module\"));\n                                   OASISSourcePatterns.Templater.Text \".mly\"\n                                ];\n                              origin = \"${uncapitalize_file module}.mly\"\n                           }\n                        ];\n                      bs_c_sources = [];\n                      bs_data_files = [];\n                      bs_findlib_extra_files = [];\n                      bs_ccopt = [(OASISExpr.EBool true, [])];\n                      bs_cclib = [(OASISExpr.EBool true, [])];\n                      bs_dlllib = [(OASISExpr.EBool true, [])];\n                      bs_dllpath = [(OASISExpr.EBool true, [])];\n                      bs_byteopt = [(OASISExpr.EBool true, [])];\n                      bs_nativeopt = [(OASISExpr.EBool true, [])]\n                   },\n                   {exec_custom = false; exec_main_is = \"bamboo.ml\"})\n            ];\n          disable_oasis_section = [];\n          conf_type = (`Configure, \"internal\", Some \"0.4\");\n          conf_custom =\n            {\n               pre_command = [(OASISExpr.EBool true, None)];\n               post_command = [(OASISExpr.EBool true, None)]\n            };\n          build_type = (`Build, \"ocamlbuild\", Some \"0.4\");\n          build_custom =\n            {\n               pre_command = [(OASISExpr.EBool true, None)];\n               post_command = [(OASISExpr.EBool true, None)]\n            };\n          install_type = (`Install, \"internal\", Some \"0.4\");\n          install_custom =\n            {\n               pre_command = [(OASISExpr.EBool true, None)];\n               post_command = [(OASISExpr.EBool true, None)]\n            };\n          uninstall_custom =\n            {\n               pre_command = [(OASISExpr.EBool true, None)];\n               post_command = [(OASISExpr.EBool true, None)]\n            };\n          clean_custom =\n            {\n               pre_command = [(OASISExpr.EBool true, None)];\n               post_command = [(OASISExpr.EBool true, None)]\n            };\n          distclean_custom =\n            {\n               pre_command = [(OASISExpr.EBool true, None)];\n               post_command = [(OASISExpr.EBool true, None)]\n            };\n          plugins = [(`Extra, \"META\", Some \"0.4\")];\n          schema_data = PropList.Data.create ();\n          plugin_data = []\n       };\n     oasis_fn = Some \"_oasis\";\n     oasis_version = \"0.4.10\";\n     oasis_digest =\n       Some \"\\016\\223\\164\\015\\2320\\133d\\134\\245\\203K\\139\\234\\205N\";\n     oasis_exec = None;\n     oasis_setup_args = [];\n     setup_update = false\n  };;\n\nlet setup () = BaseSetup.setup setup_t;;\n\n# 7851 \"setup.ml\"\nlet setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t\nopen BaseCompat.Compat_0_4\n(* OASIS_STOP *)\nlet () = setup ();;\n"
  },
  {
    "path": "sketch/future.bbo",
    "content": "contract A() {\n    case (bool a()) {\n        return (true) then become B();\n    }\n}\ncontract B() {\n    case (bool b()) {\n        return (false) then become B();\n    }\n}\ncontract C(A instance) {\n    case (bool c()) {\n        return (instance.b() reentrance { abort; }) then become C(instance);\n    }\n}\n"
  },
  {
    "path": "sketch/open_auction.bbo",
    "content": "contract auction\n\t(address _beneficiary\n\t,uint256 _bidding_time\n\t,address => bool _bids\n\t,uint256 _highest_bid)\n{\n\tcase (bool bid())\n\t{\n\t\tif (now(block) > _bidding_time)\n\t\t\treturn (false) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t\tif (value(msg) < _highest_bid)\n\t\t\tabort;\n\t\tbid new_bid =\n\t\t\tdeploy bid(sender(msg), value(msg), this) with value(msg)\n\t\t\t\treentrance { abort; }; // failure throws.\n\t\t_bids[address(new_bid)] = true;\n\t\treturn (true) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, value(msg));\n\t}\n\tcase (uint256 highest_bid())\n\t{\n\t\treturn (_highest_bid) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tcase (uint256 bidding_time())\n\t{\n\t\treturn (_bidding_time) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tdefault\n\t{\n\t\tabort; // cancels the call.\n\t}\n\n// When the control reaches the end of a contract block,\n// it causes an abort.\n}\n\n\ncontract bid\n\t(address _bidder\n\t,uint256 _value\n\t,auction _auction) // the compiler is aware that an `auction` account can become an `auction_done` account.\n{\n\tcase (bool refund())\n\t{\n\t\tif (sender(msg) != _bidder)\n\t\t\tabort;\n\t\tif (_auction.bid_is_highest(_value) reentrance { abort; })\n\t\t\tabort;\n\t\tselfdestruct(_bidder);\n\t}\n\tcase (bool pay_beneficiary())\n\t{\n\t\tif (not _auction.bid_is_highest(_value) reentrance { abort; })\n\t\t\tabort;\n\t\taddress beneficiary = _auction.beneficiary() reentrance { abort; };\n\t\tselfdestruct(beneficiary);\n\t}\n\tdefault\n\t{\n\t\tabort;\n\t}\n}\n\ncontract auction_done(address _beneficiary, address => bool _bids, uint256 _highest_bid)\n{\n\tcase (bool bid_is_highest(uint256 _cand))\n\t{\n\t\tif (not _bids[sender(msg)]) abort;\n\t\treturn (_highest_bid == _cand) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t}\n\tcase (address beneficiary())\n\t{\n\t\tif (not _bids[sender(msg)]) abort;\n\t\treturn (_beneficiary) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t}\n\tdefault\n\t{\n\t\tabort;\n\t}\n}\n"
  },
  {
    "path": "src/ast/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 48b4bddcf78ccaf67607c0efb8f15589)\nversion = \"0.0.03\"\ndescription = \"A compiler targeting Ethereum Virtual Machine\"\nrequires = \"basics cryptokit hex\"\narchive(byte) = \"ast.cma\"\narchive(byte, plugin) = \"ast.cma\"\narchive(native) = \"ast.cmxa\"\narchive(native, plugin) = \"ast.cmxs\"\nexists_if = \"ast.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/ast/ast.mldylib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 857e7a85bbf5c81d7dc95b28750b7723)\nContract\nSyntax\nTypeEnv\nType\nPseudoImm\nEvm\nLocation\nEthereum\n# OASIS_STOP\n"
  },
  {
    "path": "src/ast/ast.mllib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 857e7a85bbf5c81d7dc95b28750b7723)\nContract\nSyntax\nTypeEnv\nType\nPseudoImm\nEvm\nLocation\nEthereum\n# OASIS_STOP\n"
  },
  {
    "path": "src/ast/ast_test.ml",
    "content": "open Lexer\nopen Lexing\nopen Printf\n\n(* The following two functions comes from\n * https://github.com/realworldocaml/examples/tree/master/code/parsing-test\n * which is under UNLICENSE\n *)\nlet print_position outx lexbuf =\n  let pos = lexbuf.lex_curr_p in\n  fprintf outx \"%s:%d:%d\" pos.pos_fname\n    pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)\n\nlet parse_with_error lexbuf =\n  try Parser.file Lexer.read lexbuf with\n  | SyntaxError msg ->\n    fprintf stderr \"%a: %s\\n\" print_position lexbuf msg;\n    exit (-1)\n  | Parser.Error ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n  | _ ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n\nlet _ =\n  let lexbuf = Lexing.from_channel stdin in\n  let contracts : unit Syntax.toplevel list = parse_with_error lexbuf in\n  let contracts = Assoc.list_to_contract_id_assoc contracts in\n  let _ = Type.assign_types contracts in\n  Printf.printf \"Finished typing.\\n\"\n"
  },
  {
    "path": "src/ast/contract.ml",
    "content": "type case_interface = Ethereum.function_signature\n\nlet case_interface_of (raw : 'exp Syntax.case) : case_interface =\n  match Syntax.(raw.case_header) with\n  | Syntax.UsualCaseHeader header ->\n     { Ethereum.sig_return =\n         List.map Ethereum.interpret_interface_type Syntax.(header.case_return_typ)\n     ; sig_name = Syntax.(header.case_name)\n     ; sig_args =\n         List.map Ethereum.interpret_interface_type\n                  Syntax.(List.map (fun x -> x.arg_typ) header.case_arguments)\n     }\n  | Syntax.DefaultCaseHeader ->\n     { Ethereum.sig_return = []\n     ; sig_name = \"\" (* is this a good choice? *)\n     ; sig_args = []\n     }\n\ntype contract_interface =\n  { contract_interface_name : string\n    (** [contract_interface_name] is the name of the contract. *)\n  ; contract_interface_args : Syntax.typ list\n    (* Since [contract_interface_args] contains bool[address] and such,\n     * is's not appropriate to use the ABI signature here.\n     * As a work around, at the time of deployment, these\n     * arrays are zeroed out.\n     *)\n  ; contract_interface_cases : case_interface list\n  ; contract_interface_continuations : string list\n    (** [contract_interface_transitions] lists the names of contracts that\n        this one can continue into *)\n  }\n\nlet rec collect_continuation_in_sentence (raw : 'exp Syntax.sentence) : string list =\n  Syntax.(\n    match raw with\n    | AbortSentence -> []\n    | ReturnSentence r ->\n       begin\n         match contract_name_of_return_cont r.return_cont with\n         | None -> []\n         | Some name -> [name]\n       end\n    | AssignmentSentence (_, _) -> []\n    | VariableInitSentence _ -> []\n    | SelfdestructSentence _ -> []\n    | IfThenOnly (_, ss) ->\n       collect_continuation_in_sentences ss\n    | IfThenElse (_, s, t) ->\n       (collect_continuation_in_sentences) s @ (collect_continuation_in_sentences t)\n    | ExpSentence _ -> []\n    | LogSentence _ -> []\n  )\nand collect_continuation_in_sentences ss =\n  List.concat (List.map collect_continuation_in_sentence ss)\n\nlet collect_continuation_in_case (raw : 'exp Syntax.case) : string list =\n  List.concat Syntax.(List.map collect_continuation_in_sentence raw.case_body)\n\nlet collect_continuation_in_contract (raw : 'exp Syntax.contract) : string list =\n  List.concat Syntax.(List.map collect_continuation_in_case raw.contract_cases)\n\nlet contract_interface_of (raw : 'exp Syntax.contract) : contract_interface =\n  Syntax.\n  { contract_interface_name = raw.contract_name\n  ; contract_interface_args = List.map (fun x -> x.arg_typ) raw.contract_arguments\n  ; contract_interface_cases = List.map case_interface_of raw.contract_cases\n  ; contract_interface_continuations = collect_continuation_in_contract raw\n  }\n\nlet find_method_sig_in_contract\n      (method_name : string) (i : contract_interface)\n    : case_interface option =\n  Misc.first_some (fun case_inter ->\n      if case_inter.Ethereum.sig_name = method_name then\n        Some case_inter\n      else None\n    ) i.contract_interface_cases\n\nlet find_method_signature\n  (interfaces : contract_interface Assoc.contract_id_assoc)\n  (contract_name : string)\n  (method_name : string) : case_interface option =\n  Misc.first_some (find_method_sig_in_contract method_name) (List.map snd interfaces)\n"
  },
  {
    "path": "src/ast/contract.mli",
    "content": "type case_interface = Ethereum.function_signature\n\nval case_interface_of : 'exp Syntax.case -> case_interface\n\ntype contract_interface =\n  { contract_interface_name : string\n    (** [contract_interface_name] is the name of the contract. *)\n  ; contract_interface_args : Syntax.typ list\n  ; contract_interface_cases : case_interface list\n  ; contract_interface_continuations : string list\n    (** [contract_interface_transitions] lists the names of contracts that\n        this one can continue into *)\n  }\n\nval contract_interface_of : 'exp Syntax.contract -> contract_interface\n\nval find_method_signature :\n  contract_interface Assoc.contract_id_assoc ->\n  string (* contract name *) -> string (* method name *) -> case_interface option\n"
  },
  {
    "path": "src/ast/ethereum.ml",
    "content": "let word_bits = 256\nlet signature_bits = 32\n\ntype interface_typ =\n  | InterfaceUint of int\n  | InterfaceBytes of int\n  | InterfaceAddress\n  | InterfaceBool\n\ntype interface_arg = string * interface_typ\n\n(** [interpret_interface_type] parses \"uint\" into InterfaceUint 256, etc. *)\nlet interpret_interface_type (str : Syntax.typ) : interface_typ =\n  Syntax.\n  (match str with\n  | Uint256Type -> InterfaceUint 256\n  | Uint8Type -> InterfaceUint 8\n  | Bytes32Type -> InterfaceBytes 32\n  | AddressType -> InterfaceAddress\n  | BoolType -> InterfaceBool\n  | TupleType _ -> failwith \"interpret_interface_type: tuple types are not supported yet\"\n  | MappingType (_, _) -> failwith \"interpret_interface_type: mapping type not supported\"\n  | ContractInstanceType _ -> InterfaceAddress\n  | ContractArchType _ -> failwith \"contract arch-type does not appear in the ABI\"\n  | ReferenceType _ -> failwith \"reference type does not appear in the ABI\"\n  | VoidType -> failwith \"VoidType should not appear in the ABI\"\n  )\n\nlet to_typ (ityp : interface_typ) =\n  Syntax.\n  ( match ityp with\n    | InterfaceUint x ->\n       let () = if (x < 0 || x > 256) then\n                  failwith \"too small or too big integer\" in\n       Uint256Type\n    | InterfaceBytes x ->\n       let () = assert (x = 32) in\n       Bytes32Type\n    | InterfaceBool -> BoolType\n    | InterfaceAddress -> AddressType\n  )\n\n(* in bytes *)\nlet interface_typ_size (ityp : interface_typ) : int =\n  match ityp with\n  | InterfaceUint _ -> 32\n  | InterfaceAddress -> 32\n  | InterfaceBool -> 32\n  | InterfaceBytes _ -> 32\n\ntype function_signature =\n  { sig_return : interface_typ list\n  ; sig_name : string\n  ; sig_args : interface_typ list\n  }\n\nlet get_interface_typ (raw : Syntax.arg) : (string * interface_typ) option =\n  match Syntax.(raw.arg_typ) with\n  | Syntax.MappingType (_,_) -> None\n  | _ -> Some (raw.Syntax.arg_ident, interpret_interface_type Syntax.(raw.arg_typ))\n\nlet get_interface_typs : Syntax.arg list -> (string * interface_typ) list =\n  WrapList.filter_map get_interface_typ\n\nlet rec argument_sizes_to_positions_inner ret used sizes =\n  match sizes with\n  | [] -> List.rev ret\n  | h :: t ->\n     let () = assert (h > 0) in\n     let () = assert (h <= 32) in (* XXX using div and mod, generalization is possible *)\n     argument_sizes_to_positions_inner\n       (used + 32 - h :: ret) (used + 32) t\n\nlet argument_sizes_to_positions sizes =\n  argument_sizes_to_positions_inner [] 4 (* size of signature *) sizes\n\nlet print_arg_loc r =\n  List.iter (fun (name, loc) ->\n      Printf.printf \"argument %s at %s\\n\" name (Location.as_string loc)\n    ) r\n\nlet arguments_with_locations (c : Syntax.typ Syntax.case) : (string * Location.location) list =\n  Syntax.(\n    match c.case_header with\n    | DefaultCaseHeader -> []\n    | UsualCaseHeader h ->\n       let sizes : int list = List.map calldata_size_of_arg h.Syntax.case_arguments in\n       let positions : int list = argument_sizes_to_positions sizes in\n       let size_pos : (int * int) list = List.combine positions sizes in\n       let locations : Location.location list = List.map (fun (o, s) -> Location.(Calldata {calldata_offset = o; calldata_size = s})) size_pos in\n       let names : string list = List.map (fun a -> a.Syntax.arg_ident) h.Syntax.case_arguments in\n       let ret = List.combine names locations in\n       ret\n  )\n\nlet get_array (raw : Syntax.arg) : (string * Syntax.typ * Syntax.typ) option =\n  match Syntax.(raw.arg_typ) with\n  | Syntax.MappingType (k, v) -> Some (raw.Syntax.arg_ident, k, v)\n  | _ -> None\n\nlet arrays_in_contract c : (string * Syntax.typ * Syntax.typ) list =\n  WrapList.filter_map get_array (c.Syntax.contract_arguments)\n\nlet constructor_arguments (contract : Syntax.typ Syntax.contract)\n    : (string * interface_typ) list\n  = get_interface_typs (contract.Syntax.contract_arguments)\n\nlet total_size_of_interface_args lst : int =\n  try WrapList.sum (List.map interface_typ_size lst) with\n        Invalid_argument _ -> 0\n\nlet string_keccak = WrapCryptokit.string_keccak\n\nlet hex_keccak = WrapCryptokit.hex_keccak\n\n(* Since `string_keccak` returns a hex representation of byte sequence,\n   as we want the first four bytes, we need to take the first eight characters. *)\nlet keccak_signature (str : string) : string =\n  String.sub (string_keccak str) 0 8\n\nlet string_of_interface_type (i : interface_typ) : string =\n  match i with\n  | InterfaceUint x ->\n     \"uint\"^(string_of_int x)\n  | InterfaceBytes x ->\n     \"bytes\"^(string_of_int x)\n  | InterfaceAddress -> \"address\"\n  | InterfaceBool -> \"bool\"\n\nlet case_header_signature_string (h : Syntax.usual_case_header) : string =\n  let name_of_case = h.Syntax.case_name in\n  let arguments = get_interface_typs h.Syntax.case_arguments in\n  let arg_typs = List.map snd arguments in\n  let list_of_types = List.map string_of_interface_type arg_typs in\n  let args = String.concat \",\" list_of_types in\n  name_of_case ^ \"(\" ^ args ^ \")\"\n\n(* XXX: refactor with the above function *)\nlet event_signature_string (e : Syntax.event) : string =\n  (* do I consider indexed no? *)\n  let name = e.Syntax.event_name in\n  let arguments = get_interface_typs (List.map Syntax.arg_of_event_arg e.Syntax.event_arguments) in\n  let arg_typs = List.map snd arguments in\n  let list_of_types = List.map string_of_interface_type arg_typs in\n  let args = String.concat \",\" list_of_types in\n  name ^ \"(\" ^ args ^ \")\"\n\nlet case_header_signature_hash (h : Syntax.usual_case_header) : string =\n  let sign = case_header_signature_string h in\n  keccak_signature sign\n\nlet event_signature_hash (e : Syntax.event) : string =\n  let sign = event_signature_string e in\n  keccak_signature sign\n\nlet compute_signature_hash (signature : string) : string =\n  String.sub (string_keccak signature) 0 8\n\nlet print_default_header =\n  \"{\\\"type\\\":\\\"fallback\\\",\\\"inputs\\\": [],\\\"outputs\\\": [],\\\"payable\\\": true}\"\n\nlet print_input_abi (arg : Syntax.arg) : string =\n  Printf.sprintf \"{\\\"name\\\": \\\"%s\\\", \\\"type\\\": \\\"%s\\\"}\"\n                 (arg.Syntax.arg_ident)\n                 (string_of_interface_type (interpret_interface_type arg.Syntax.arg_typ))\n\nlet print_inputs_abi (args : Syntax.arg list) : string =\n  let strings = List.map print_input_abi args in\n  String.concat \",\" strings\n\nlet print_output_abi (typ : Syntax.typ) : string =\n  Printf.sprintf \"{\\\"name\\\": \\\"\\\", \\\"type\\\": \\\"%s\\\"}\"\n                 (string_of_interface_type (interpret_interface_type typ))\n\nlet print_outputs_abi (typs : Syntax.typ list) : string =\n  let strings = List.map print_output_abi typs in\n  String.concat \",\" strings\n\nlet print_usual_case_abi u =\n  Printf.sprintf\n    \"{\\\"type\\\":\\\"function\\\",\\\"name\\\":\\\"%s\\\",\\\"inputs\\\": [%s],\\\"outputs\\\": [%s],\\\"payable\\\": true}\"\n    (u.Syntax.case_name)\n    (print_inputs_abi u.Syntax.case_arguments)\n    (print_outputs_abi u.Syntax.case_return_typ)\n\nlet print_case_abi (c : Syntax.typ Syntax.case) : string =\n  match c.Syntax.case_header with\n  | Syntax.UsualCaseHeader u ->\n     print_usual_case_abi u\n  | Syntax.DefaultCaseHeader ->\n     print_default_header\n\nlet print_constructor_abi (c : Syntax.typ Syntax.contract) : string =\n  Printf.sprintf\n    \"{\\\"type\\\": \\\"constructor\\\", \\\"inputs\\\":[%s], \\\"name\\\": \\\"%s\\\", \\\"outputs\\\":[], \\\"payable\\\": true}\"\n    (print_inputs_abi (List.filter Syntax.non_mapping_arg c.Syntax.contract_arguments))\n    (c.Syntax.contract_name)\n\nlet print_contract_abi seen_constructor (c : Syntax.typ Syntax.contract) : string =\n  let cases = c.Syntax.contract_cases in\n  let strings : string list = List.map print_case_abi cases in\n  let strings = if !seen_constructor then strings\n                else (print_constructor_abi c) :: strings in\n  let () = (seen_constructor := true) in\n  String.concat \",\" strings\n\nlet print_event_arg (a : Syntax.event_arg) : string =\n  Printf.sprintf \"{\\\"name\\\":\\\"%s\\\",\\\"type\\\":\\\"%s\\\",\\\"indexed\\\":%s}\"\n                 Syntax.(a.event_arg_body.arg_ident)\n                 (string_of_interface_type (interpret_interface_type Syntax.(a.event_arg_body.arg_typ)))\n                 (string_of_bool a.Syntax.event_arg_indexed)\n\nlet print_event_inputs (is : Syntax.event_arg list) : string =\n  let strings : string list = List.map print_event_arg is in\n  String.concat \",\" strings\n\nlet print_event_abi (e : Syntax.event) : string =\n  Printf.sprintf\n    \"{\\\"type\\\":\\\"event\\\",\\\"inputs\\\":[%s],\\\"name\\\":\\\"%s\\\"}\"\n    (print_event_inputs e.Syntax.event_arguments)\n    (e.Syntax.event_name)\n\nlet print_toplevel_abi seen_constructor (t : Syntax.typ Syntax.toplevel) : string =\n  match t with\n  | Syntax.Contract c ->\n     print_contract_abi seen_constructor c\n  | Syntax.Event e ->\n     print_event_abi e\n\nlet print_abi (tops : Syntax.typ Syntax.toplevel Assoc.contract_id_assoc) : unit =\n  let seen_constructor = ref false in\n  let () = Printf.printf \"[\" in\n  let strings : string list = List.filter (fun s -> (String.length s) != 0) (List.map (print_toplevel_abi seen_constructor) (Assoc.values tops)) in\n  let () = Printf.printf \"%s\" (String.concat \",\" strings) in\n  Printf.printf \"]\"\n"
  },
  {
    "path": "src/ast/ethereum.mli",
    "content": "val word_bits : int\nval signature_bits : int\n\ntype interface_typ =\n  | InterfaceUint of int\n  | InterfaceBytes of int\n  | InterfaceAddress\n  | InterfaceBool\n\n(** size of values of the interface type in bytes *)\nval interface_typ_size : interface_typ -> int\n\ntype interface_arg = string * interface_typ\n\n(** [interpret_interface_type] parses \"uint\" into InterfaceUint 256, etc. *)\nval interpret_interface_type : Syntax.typ -> interface_typ\n\nval to_typ : interface_typ -> Syntax.typ\n\n(** [string_of_interface_type t] is a string that is used to compute the\n * method signatures.  Addresses are \"address\", uint is \"uint256\". *)\nval string_of_interface_type : interface_typ -> string\n\ntype function_signature =\n  { sig_return : interface_typ list\n  ; sig_name : string\n  ; sig_args : interface_typ list\n  }\n\nval get_interface_typs :\n  Syntax.arg list -> (string * interface_typ) list\n\nval arguments_with_locations :\n  Syntax.typ Syntax.case -> (string * Location.location) list\n\nval constructor_arguments :\n  Syntax.typ Syntax.contract -> (string * interface_typ) list\n\nval arrays_in_contract :\n  Syntax.typ Syntax.contract -> (string * Syntax.typ * Syntax.typ) list\n\nval total_size_of_interface_args :\n  interface_typ list -> int\n\n(** [string_keccak] returns the Keccak-256 hash of a string in\n * hex, without the prefix [0x]. *)\nval string_keccak : string -> string\n\n(** [hex_keccak] expects a hex string and returns the Keccak-256 hash of the\n *  represented byte sequence, without the prefix [0x]. *)\nval hex_keccak : string -> string\n\n(** [keccak_short \"pay(address)\"] returns the\n * method signature code (which is commonly used in the ABI.\n *)\nval keccak_signature : string -> string\n\n(** [case_heaer_signature_string h] returns the\n * signature of a fucntion as used for creating the\n * function hash.  Like \"pay(address)\"\n * TODO: cite some document here.\n *)\nval case_header_signature_string : Syntax.usual_case_header -> string\n\n(** [compute_singature_hash] takes a string like `f(uint8,address)` and\n returns a 4byte signature hash commonly used in Ethereum ABI. *)\nval compute_signature_hash : string -> string\n\n(** [case_header_signature_hash h] returns the\n * method signature used in the common ABI.\n * The hex hash comes without 0x\n *)\nval case_header_signature_hash :\n  Syntax.usual_case_header -> string\n\nval event_signature_hash :\n  Syntax.event -> string\n\nval print_abi : Syntax.typ Syntax.toplevel Assoc.contract_id_assoc -> unit\n"
  },
  {
    "path": "src/ast/evm.ml",
    "content": "type 'imm instruction =\n  | PUSH1 of 'imm\n  | PUSH4 of 'imm\n  | PUSH32 of 'imm\n  | NOT\n  | TIMESTAMP\n  | EQ\n  | ISZERO\n  | LT\n  | GT\n  | BALANCE\n  | STOP\n  | ADD\n  | MUL\n  | SUB\n  | DIV\n  | SDIV\n  | MOD\n  | SMOD\n  | ADDMOD\n  | MULMOD\n  | EXP\n  | SIGNEXTEND\n  | SHA3\n  | ADDRESS\n  | ORIGIN\n  | CALLER\n  | CALLVALUE\n  | CALLDATALOAD\n  | CALLDATASIZE\n  | CALLDATACOPY\n  | CODESIZE\n  | CODECOPY\n  | GASPRICE\n  | EXTCODESIZE\n  | EXTCODECOPY\n  | POP\n  | MLOAD\n  | MSTORE\n  | MSTORE8\n  | SLOAD\n  | SSTORE\n  | JUMP\n  | JUMPI\n  | PC\n  | MSIZE\n  | GAS\n  | JUMPDEST of Label.label\n  | LOG0\n  | LOG1\n  | LOG2\n  | LOG3\n  | LOG4\n  | CREATE\n  | CALL\n  | CALLCODE\n  | RETURN\n  | DELEGATECALL\n  | SUICIDE\n  | SWAP1\n  | SWAP2\n  | SWAP3\n  | SWAP4\n  | SWAP5\n  | SWAP6\n  | DUP1\n  | DUP2\n  | DUP3\n  | DUP4\n  | DUP5\n  | DUP6\n  | DUP7\n\ntype 'imm program = 'imm instruction list\nlet num_instructions = List.length\n\nlet empty_program = []\n\n(** The program is stored in the reverse order *)\nlet append_inst orig i = i :: orig\n\nlet to_list (p : 'imm program) =\n  List.rev p\n\nlet stack_eaten = function\n  | PUSH1 _ -> 0\n  | PUSH4 _ -> 0\n  | PUSH32 _ -> 0\n  | NOT -> 1\n  | TIMESTAMP -> 0\n  | EQ -> 2\n  | ISZERO -> 1\n  | LT -> 2\n  | GT -> 2\n  | BALANCE -> 1\n  | STOP -> 0\n  | ADD -> 2\n  | MUL -> 2\n  | SUB -> 2\n  | DIV -> 2\n  | SDIV -> 2\n  | MOD -> 2\n  | SMOD -> 2\n  | ADDMOD -> 3\n  | MULMOD -> 3\n  | EXP -> 2\n  | SIGNEXTEND -> 2\n  | SHA3 -> 2\n  | ADDRESS -> 0\n  | ORIGIN -> 0\n  | CALLER -> 0\n  | CALLVALUE -> 0\n  | CALLDATALOAD -> 1\n  | CALLDATASIZE -> 0\n  | CALLDATACOPY -> 3\n  | CODESIZE -> 0\n  | CODECOPY -> 3\n  | GASPRICE -> 0\n  | EXTCODESIZE -> 1\n  | EXTCODECOPY -> 4\n  | POP -> 1\n  | MLOAD -> 1\n  | MSTORE -> 2\n  | MSTORE8 -> 2\n  | SLOAD -> 1\n  | SSTORE -> 2\n  | JUMP -> 1\n  | JUMPI -> 2\n  | PC -> 0\n  | MSIZE -> 0\n  | GAS -> 0\n  | JUMPDEST _ -> 0\n  | SWAP1 -> 2\n  | SWAP2 -> 3\n  | SWAP3 -> 4\n  | SWAP4 -> 5\n  | SWAP5 -> 6\n  | SWAP6 -> 7\n  | LOG0 -> 2\n  | LOG1 -> 3\n  | LOG2 -> 4\n  | LOG3 -> 5\n  | LOG4 -> 6\n  | CREATE -> 3\n  | CALL -> 7\n  | CALLCODE -> 7\n  | RETURN -> 2\n  | DELEGATECALL -> 7\n  | SUICIDE -> 1\n  | DUP1 -> 1\n  | DUP2 -> 2\n  | DUP3 -> 3\n  | DUP4 -> 4\n  | DUP5 -> 5\n  | DUP6 -> 6\n  | DUP7 -> 7\n\n\nlet stack_pushed = function\n  | PUSH1 _ -> 1\n  | PUSH4 _ -> 1\n  | PUSH32 _ -> 1\n  | NOT -> 1\n  | TIMESTAMP -> 1\n  | EQ -> 1\n  | ISZERO -> 1\n  | LT -> 1\n  | GT -> 1\n  | BALANCE -> 1\n  | STOP -> 0\n  | ADD -> 1\n  | MUL -> 1\n  | SUB -> 1\n  | DIV -> 1\n  | SDIV -> 1\n  | EXP -> 1\n  | MOD -> 1\n  | SMOD -> 1\n  | ADDMOD -> 1\n  | MULMOD -> 1\n  | SIGNEXTEND -> 1\n  | SHA3 -> 1\n  | ADDRESS -> 1\n  | ORIGIN -> 1\n  | CALLER -> 1\n  | CALLVALUE -> 1\n  | CALLDATALOAD -> 1\n  | CALLDATASIZE -> 1\n  | CALLDATACOPY -> 0\n  | CODESIZE -> 1\n  | CODECOPY -> 0\n  | GASPRICE -> 1\n  | EXTCODESIZE -> 1\n  | EXTCODECOPY -> 0\n  | POP -> 0\n  | MLOAD -> 1\n  | MSTORE -> 0\n  | MSTORE8 -> 0\n  | SLOAD -> 1\n  | SSTORE -> 0\n  | JUMP -> 0\n  | JUMPI -> 0\n  | PC -> 1\n  | MSIZE -> 1\n  | GAS -> 1\n  | JUMPDEST _ -> 0\n  | SWAP1 -> 2\n  | SWAP2 -> 3\n  | SWAP3 -> 4\n  | SWAP4 -> 5\n  | SWAP5 -> 6\n  | SWAP6 -> 7\n  | DUP1 -> 2\n  | DUP2 -> 3\n  | DUP3 -> 4\n  | DUP4 -> 5\n  | DUP5 -> 6\n  | DUP6 -> 7\n  | DUP7 -> 8\n  | LOG0 -> 0\n  | LOG1 -> 0\n  | LOG2 -> 0\n  | LOG3 -> 0\n  | LOG4 -> 0\n  | CREATE -> 1\n  | CALL -> 1\n  | CALLCODE -> 1\n  | RETURN -> 0\n  | DELEGATECALL -> 1\n  | SUICIDE -> 0\n\nlet string_of_pseudo_opcode op =\n  match op with\n  | PUSH1 v -> \"PUSH1 \"^(PseudoImm.string_of_pseudo_imm v)\n  | PUSH4 v -> \"PUSH4 \"^(PseudoImm.string_of_pseudo_imm v)\n  | PUSH32 v -> \"PUSH32 \"^(PseudoImm.string_of_pseudo_imm v)\n  | NOT -> \"NOT\"\n  | TIMESTAMP -> \"TIMESTAMP\"\n  | EQ -> \"EQ\"\n  | ISZERO -> \"ISZERO\"\n  | LT -> \"LT\"\n  | GT -> \"GT\"\n  | BALANCE -> \"BALANCE\"\n  | STOP -> \"STOP\"\n  | ADD -> \"ADD\"\n  | MUL -> \"MUL\"\n  | SUB -> \"SUB\"\n  | DIV -> \"DIV\"\n  | SDIV -> \"SDIV\"\n  | EXP -> \"EXP\"\n  | MOD -> \"MOD\"\n  | SMOD -> \"SMOD\"\n  | ADDMOD -> \"ADDMOD\"\n  | MULMOD -> \"MULMOD\"\n  | SIGNEXTEND -> \"SIGNEXTEND\"\n  | SHA3 -> \"SHA3\"\n  | ADDRESS -> \"ADDRESS\"\n  | ORIGIN -> \"ORIGIN\"\n  | CALLER -> \"CALLER\"\n  | CALLVALUE -> \"CALLVALUE\"\n  | CALLDATALOAD -> \"CALLDATALOAD\"\n  | CALLDATASIZE -> \"CALLDATASIZE\"\n  | CALLDATACOPY -> \"CALLDATACOPY\"\n  | CODESIZE -> \"CODESIZE\"\n  | CODECOPY -> \"CODECOPY\"\n  | GASPRICE -> \"GASPRICE\"\n  | EXTCODESIZE -> \"EXTCODESIZE\"\n  | EXTCODECOPY -> \"EXTCODECOPY\"\n  | POP -> \"POP\"\n  | MLOAD -> \"MLOAD\"\n  | MSTORE -> \"MSTORE\"\n  | MSTORE8 -> \"MSTORE8\"\n  | SLOAD -> \"SLOAD\"\n  | SSTORE -> \"SSTORE\"\n  | JUMP -> \"JUMP\"\n  | JUMPI -> \"JUMPI\"\n  | PC -> \"PC\"\n  | MSIZE -> \"MSIZE\"\n  | GAS -> \"GAS\"\n  | JUMPDEST l -> \"JUMPDEST (print label)\"\n  | SWAP1 -> \"SWAP1\"\n  | SWAP2 -> \"SWAP2\"\n  | SWAP3 -> \"SWAP3\"\n  | SWAP4 -> \"SWAP5\"\n  | SWAP5 -> \"SWAP5\"\n  | SWAP6 -> \"SWAP6\"\n  | DUP1 -> \"DUP1\"\n  | DUP2 -> \"DUP2\"\n  | DUP3 -> \"DUP3\"\n  | DUP4 -> \"DUP4\"\n  | DUP5 -> \"DUP5\"\n  | DUP6 -> \"DUP6\"\n  | DUP7 -> \"DUP7\"\n  | LOG0 -> \"LOG0\"\n  | LOG1 -> \"LOG1\"\n  | LOG2 -> \"LOG2\"\n  | LOG3 -> \"LOG3\"\n  | LOG4 -> \"LOG4\"\n  | CREATE -> \"CREATE\"\n  | CALL -> \"CALL\"\n  | CALLCODE -> \"CALLCODE\"\n  | RETURN -> \"RETURN\"\n  | DELEGATECALL -> \"DELEGATECALL\"\n  | SUICIDE -> \"SUICIDE\"\n\nlet string_of_pseudo_program prg =\n  let op_lst = to_list prg in\n  String.concat \"\" (List.map (fun op -> string_of_pseudo_opcode op ^ \"\\n\") op_lst)\n\nlet print_pseudo_program prg =\n  Printf.printf \"%s\" (string_of_pseudo_program prg)\n\nlet hex_of_instruction (i : WrapBn.t instruction) : Hexa.hex =\n  let h = Hexa.hex_of_string in\n  match i with\n  | PUSH1 i -> Hexa.concat_hex (h \"60\") (Hexa.hex_of_big_int i 1)\n  | PUSH4 i -> Hexa.concat_hex (h \"63\") (Hexa.hex_of_big_int i 4)\n  | PUSH32 i -> Hexa.concat_hex (h \"7f\") (Hexa.hex_of_big_int i 32)\n  | NOT -> h \"19\"\n  | TIMESTAMP -> h \"42\"\n  | EQ -> h \"14\"\n  | ISZERO -> h \"15\"\n  | LT -> h \"10\"\n  | GT -> h \"11\"\n  | BALANCE -> h \"31\"\n  | STOP -> h \"00\"\n  | ADD -> h \"01\"\n  | MUL -> h \"02\"\n  | SUB -> h \"03\"\n  | DIV -> h \"04\"\n  | SDIV -> h \"05\"\n  | MOD -> h \"06\"\n  | SMOD -> h \"07\"\n  | ADDMOD -> h \"08\"\n  | MULMOD -> h \"09\"\n  | EXP -> h \"0a\"\n  | SIGNEXTEND -> h \"0b\"\n  | SHA3 -> h \"20\"\n  | ADDRESS -> h \"30\"\n  | ORIGIN -> h \"32\"\n  | CALLER -> h \"33\"\n  | CALLVALUE -> h \"34\"\n  | CALLDATALOAD -> h \"35\"\n  | CALLDATASIZE -> h \"36\"\n  | CALLDATACOPY -> h \"37\"\n  | CODESIZE -> h \"38\"\n  | CODECOPY -> h \"39\"\n  | GASPRICE -> h \"3a\"\n  | EXTCODESIZE -> h \"3b\"\n  | EXTCODECOPY -> h \"3c\"\n  | POP -> h \"50\"\n  | MLOAD -> h \"51\"\n  | MSTORE -> h \"52\"\n  | MSTORE8 -> h \"53\"\n  | SLOAD -> h \"54\"\n  | SSTORE -> h \"55\"\n  | JUMP -> h \"56\"\n  | JUMPI -> h \"57\"\n  | PC -> h \"58\"\n  | MSIZE -> h \"59\"\n  | GAS -> h \"5a\"\n  | JUMPDEST _ -> h \"5b\"\n  | LOG0 -> h \"a0\"\n  | LOG1 -> h \"a1\"\n  | LOG2 -> h \"a2\"\n  | LOG3 -> h \"a3\"\n  | LOG4 -> h \"a4\"\n  | CREATE -> h \"f0\"\n  | CALL -> h \"f1\"\n  | CALLCODE -> h \"f2\"\n  | RETURN -> h \"f3\"\n  | DELEGATECALL -> h \"f4\"\n  | SUICIDE -> h \"ff\"\n  | SWAP1 -> h \"90\"\n  | SWAP2 -> h \"91\"\n  | SWAP3 -> h \"92\"\n  | SWAP4 -> h \"93\"\n  | SWAP5 -> h \"94\"\n  | SWAP6 -> h \"95\"\n  | DUP1 -> h \"80\"\n  | DUP2 -> h \"81\"\n  | DUP3 -> h \"82\"\n  | DUP4 -> h \"83\"\n  | DUP5 -> h \"84\"\n  | DUP6 -> h \"85\"\n  | DUP7 -> h \"86\"\n\nlet log (n : int) =\n  match n with\n  | 0 -> LOG0\n  | 1 -> LOG1\n  | 2 -> LOG2\n  | 3 -> LOG3\n  | 4 -> LOG4\n  | _ -> failwith \"too many indexed arguments for an event\"\n\nlet rev_append_op (h : Hexa.hex) (i : WrapBn.t instruction) : Hexa.hex =\n  Hexa.concat_hex (hex_of_instruction i) h\n\nlet hex_of_program (p : WrapBn.t program) : Hexa.hex =\n  List.fold_left rev_append_op Hexa.empty_hex p\n\nlet print_imm_program (p : WrapBn.t program) : unit =\n  let hex = hex_of_program p in\n  Hexa.print_hex ~prefix:\"0x\" hex\n\nlet string_of_imm_program (p : WrapBn.t program) : string =\n  let hex = hex_of_program p in\n  Hexa.string_of_hex ~prefix:\"0x\" hex\n\nlet size_of_instruction i =\n  match i with\n  | PUSH1 _ -> 2\n  | PUSH4 _ -> 5\n  | PUSH32 _ -> 33\n  | _ -> 1\n\nlet size_of_program p =\n  List.fold_left (fun a i -> a + size_of_instruction i) 0 p\n\nlet dup_suc_n (n : int) =\n  match n with\n  | 0 -> DUP1\n  | 1 -> DUP2\n  | 2 -> DUP3\n  | 3 -> DUP4\n  | 4 -> DUP5\n  | 5 -> DUP6\n  | 6 -> DUP7\n  | _ -> failwith \"more DUP instructions needed\"\n"
  },
  {
    "path": "src/ast/evm.mli",
    "content": "type 'imm instruction =\n  | PUSH1 of 'imm\n  | PUSH4 of 'imm\n  | PUSH32 of 'imm\n  | NOT\n  | TIMESTAMP\n  | EQ\n  | ISZERO\n  | LT\n  | GT\n  | BALANCE\n  | STOP\n  | ADD\n  | MUL\n  | SUB\n  | DIV\n  | SDIV\n  | MOD\n  | SMOD\n  | ADDMOD\n  | MULMOD\n  | EXP\n  | SIGNEXTEND\n  | SHA3\n  | ADDRESS\n  | ORIGIN\n  | CALLER\n  | CALLVALUE\n  | CALLDATALOAD\n  | CALLDATASIZE\n  | CALLDATACOPY\n  | CODESIZE\n  | CODECOPY\n  | GASPRICE\n  | EXTCODESIZE\n  | EXTCODECOPY\n  | POP\n  | MLOAD\n  | MSTORE\n  | MSTORE8\n  | SLOAD\n  | SSTORE\n  | JUMP\n  | JUMPI\n  | PC\n  | MSIZE\n  | GAS\n  | JUMPDEST of Label.label\n  | LOG0\n  | LOG1\n  | LOG2\n  | LOG3\n  | LOG4\n  | CREATE\n  | CALL\n  | CALLCODE\n  | RETURN\n  | DELEGATECALL\n  | SUICIDE\n  | SWAP1\n  | SWAP2\n  | SWAP3\n  | SWAP4\n  | SWAP5\n  | SWAP6\n  | DUP1\n  | DUP2\n  | DUP3\n  | DUP4\n  | DUP5\n  | DUP6\n  | DUP7\n\nval log : int -> 'a instruction\n\n\nval dup_suc_n : int -> 'imm instruction\n\n(** ['imm program] is a sequence of EVM instructions\n * where immediate values are expressed with type 'imm *)\ntype 'imm program = 'imm instruction list\nval empty_program : 'imm program\n\nval num_instructions : 'imm program -> int\n\nval append_inst : 'imm program -> 'imm instruction -> 'imm program\n\nval stack_eaten : 'imm instruction -> int\nval stack_pushed : 'imm instruction -> int\n\nval string_of_pseudo_opcode : PseudoImm.pseudo_imm instruction -> string\n\nval string_of_pseudo_program : PseudoImm.pseudo_imm program -> string\nval print_pseudo_program : PseudoImm.pseudo_imm program -> unit\n\nval hex_of_instruction : WrapBn.t instruction -> Hexa.hex\nval hex_of_program : WrapBn.t program -> Hexa.hex\n\nval string_of_imm_program : WrapBn.t program -> string\nval print_imm_program : WrapBn.t program -> unit\n\nval size_of_instruction : 'exp instruction -> int\nval size_of_program : 'exp program -> int\n\n(*\nCommented out till we need it.\n\nval string_of_real_instruction :\n  WrapBn.t instruction -> string\nval string_of_real_program : WrapBn.t program -> unit\n*)\n"
  },
  {
    "path": "src/ast/location.ml",
    "content": "type 'imm memory_range =\n  { memory_start : 'imm (* In byte as in EVM *)\n  ; memory_size  : 'imm (* In byte *)\n  }\n\ntype 'imm storage_range =\n  { storage_start : 'imm (* In word as in EVM *)\n  ; storage_size :  'imm (* In word *)\n  }\n\ntype 'imm code_range =\n  { code_start : 'imm (* In byte *)\n  ; code_size  : 'imm\n  }\n\ntype 'imm volatile_location =\n  | Memory of 'imm memory_range\n  | Stack of int\n  (** [Stack 0] is the deepest element in the stack.\n   * The stack usage should be known from the beginning of the\n   * code generation.\n   *)\n\ntype 'imm cached_storage =\n  { cached_original: 'imm storage_range\n  ; modified : bool (* if the cache has to be written again *)\n  ; cache : 'imm volatile_location\n  }\n\ntype calldata_range =\n  { calldata_offset : int\n  ; calldata_size : int\n  }\n\ntype location =\n  | Storage of PseudoImm.pseudo_imm storage_range\n  | CachedStorage of PseudoImm.pseudo_imm cached_storage\n  | Volatile of PseudoImm.pseudo_imm volatile_location\n  | Code of PseudoImm.pseudo_imm code_range\n  | Calldata of calldata_range\n  | Stack of int\n\nlet as_string (l : location) : string =\n  match l with\n  | Storage _ -> \"Storage ...\"\n  | CachedStorage _ -> \"CachedStorage ...\"\n  | Volatile _ -> \"Volatile ...\"\n  | Code _ -> \"Code ...\"\n  | Calldata c -> Printf.sprintf \"Calldata offset %d, size %d\" c.calldata_offset c.calldata_size\n  | Stack i -> Printf.sprintf \"Stack %d\" i\n"
  },
  {
    "path": "src/ast/location.mli",
    "content": "(* This module annotates idents with the locations of the data *)\n\ntype 'imm memory_range =\n  { memory_start : 'imm (* In byte as in EVM *)\n  ; memory_size  : 'imm (* In byte *)\n  }\n\ntype 'imm storage_range =\n  { storage_start : 'imm (* In word as in EVM *)\n  ; storage_size :  'imm (* In word *)\n  }\n\ntype 'imm code_range =\n  { code_start : 'imm (* In byte *)\n  ; code_size  : 'imm\n  }\n\ntype 'imm volatile_location =\n  | Memory of 'imm memory_range\n  | Stack of int\n  (** [Stack 0] is the deepest element in the stack.\n   * The stack usage should be known from the beginning of the\n   * code generation.\n   *)\n\ntype 'imm cached_storage =\n  { cached_original: 'imm storage_range\n  ; modified : bool (* if the cache has to be written again *)\n  ; cache : 'imm volatile_location\n  }\n\ntype calldata_range =\n  { calldata_offset : int\n  ; calldata_size : int\n  }\n\ntype location =\n  | Storage of PseudoImm.pseudo_imm storage_range\n  | CachedStorage of PseudoImm.pseudo_imm cached_storage\n  | Volatile of PseudoImm.pseudo_imm volatile_location\n  | Code of PseudoImm.pseudo_imm code_range\n  | Calldata of calldata_range\n  | Stack of int\n\nval as_string : location -> string\n"
  },
  {
    "path": "src/ast/pseudoImm.ml",
    "content": "(* pseudo immediate value *)\n\ntype pseudo_imm =\n  | Big of WrapBn.t\n  | Int of int\n  | DestLabel of Label.label\n  | StorageProgramCounterIndex\n  | StorageConstructorArgumentsBegin of Assoc.contract_id\n  | StorageConstructorArgumentsSize of Assoc.contract_id (* the size is dependent on the contract id *)\n  | InitDataSize of Assoc.contract_id\n  | ContractOffsetInRuntimeCode of Assoc.contract_id (* where in the runtime code does the contract start.  This index should be a JUMPDEST *)\n  | CaseOffsetInRuntimeCode of Assoc.contract_id * Syntax.case_header\n  | ConstructorCodeSize of Assoc.contract_id\n  | ConstructorInRuntimeCodeOffset of Assoc.contract_id\n  | RuntimeCodeOffset of Assoc.contract_id\n  | RuntimeCodeSize\n  | Minus of pseudo_imm * pseudo_imm\n\nlet rec string_of_pseudo_imm (p : pseudo_imm) : string =\n  match p with\n  | Big b -> \"(Big \"^(WrapBn.string_of_big_int b)^\")\"\n  | Int i -> \"(Int \"^(string_of_int i)^\")\"\n  | DestLabel _ -> \"DestLabel (print label here)\"\n  | StorageProgramCounterIndex -> \"StorageProgramCounterIndex\"\n  | StorageConstructorArgumentsBegin _ -> \"StorageConstructorArgumentBegin (print contract id)\"\n  | StorageConstructorArgumentsSize _ -> \"StorageConstructorArgumentsSize (print contract id)\"\n  | InitDataSize cid -> \"InitDataSize (print contract id here)\"\n  | ContractOffsetInRuntimeCode _ -> \"ContractOffsetInRuntimeCode (print contact id)\"\n  | CaseOffsetInRuntimeCode (cid, header) -> \"CaseOffsetInRuntimeCode (print contract id, case header)\"\n  | ConstructorCodeSize cid -> \"ConstructorCodeSize (print contract id)\"\n  | ConstructorInRuntimeCodeOffset cid -> \"ConstructorInRuntimeCodeOffset (print contract id)\"\n  | RuntimeCodeOffset cid -> \"RuntimeCodeOffset (print contract id)\"\n  | RuntimeCodeSize -> \"RuntimeCodeSize\"\n  | Minus (a, b) -> \"(- \"^(string_of_pseudo_imm a)^\" \"^(string_of_pseudo_imm b)^\")\"\n\nlet is_constant_big (b : WrapBn.t) (p : pseudo_imm) : bool =\n  match p with\n  | Big b' -> WrapBn.eq_big_int b b'\n  | Int i  -> WrapBn.(eq_big_int (big_int_of_int i) b)\n  | _ -> false (* XXX: very rough approximation *)\n\nlet is_constant_int (i : int) =\n  is_constant_big (WrapBn.big_int_of_int i)\n"
  },
  {
    "path": "src/ast/pseudoImm.mli",
    "content": "(* pseudo immediate value *)\n\ntype pseudo_imm =\n  | Big of WrapBn.t\n  | Int of int\n  | DestLabel of Label.label\n  | StorageProgramCounterIndex\n  | StorageConstructorArgumentsBegin of Assoc.contract_id\n  | StorageConstructorArgumentsSize of Assoc.contract_id\n  | InitDataSize of Assoc.contract_id\n  (** [InitDataSize cid] represents the size of the data sent to create the transaction.\n   *  This data contains the initializing code plus runtime code plus the constructor\n   *  argument data.  Since the constructor arguments differ from a contract to a contract,\n   *  [InitDataSize] requires a contract id.\n   *)\n  | ContractOffsetInRuntimeCode of Assoc.contract_id (* where in the runtime code does the contract start.  This index should be a JUMPDEST *)\n  | CaseOffsetInRuntimeCode of Assoc.contract_id * Syntax.case_header\n\n  (* constructor code is the part of the init code before the runtime code as payload.  *)\n  | ConstructorCodeSize of Assoc.contract_id\n  (* for runtime code creation, the runtime code also contains the constructor code. *)\n  | ConstructorInRuntimeCodeOffset of Assoc.contract_id\n\n  | RuntimeCodeOffset of Assoc.contract_id\n  | RuntimeCodeSize\n  | Minus of pseudo_imm * pseudo_imm\n\n\nval string_of_pseudo_imm : pseudo_imm -> string\n\nval is_constant_big : WrapBn.t -> pseudo_imm -> bool\nval is_constant_int : int -> pseudo_imm -> bool\n"
  },
  {
    "path": "src/ast/sideEffect.ml",
    "content": "type location = Storage | External | Balance\ntype kind = Read | Write\n\ntype t = location * kind\n"
  },
  {
    "path": "src/ast/sideEffect.mli",
    "content": "type location = Storage | External | Balance\ntype kind = Read | Write\n\ntype t = location * kind\n"
  },
  {
    "path": "src/ast/syntax.ml",
    "content": "type typ =\n  | VoidType\n  | Uint256Type\n  | Uint8Type\n  | Bytes32Type\n  | AddressType\n  | BoolType\n  | ReferenceType of\n      typ list (** pointer to [typ list] on memory *)\n  | TupleType of typ list\n  | MappingType of typ * typ\n  | ContractArchType of string (* type of [bid(...)] where bid is a contract *)\n  | ContractInstanceType of string (* type of [b] declared as [bid b] *)\n\nlet rec string_of_typ t =\n  match t with\n  | VoidType -> \"void\"\n  | Uint256Type -> \"uint256\"\n  | Uint8Type -> \"uint8\"\n  | Bytes32Type -> \"bytes32\"\n  | AddressType -> \"address\"\n  | BoolType -> \"bool\"\n  | MappingType (a, b) -> \"mapping (\"^string_of_typ a^\" => \"^string_of_typ b^\")\"\n  | ContractArchType s -> \"ContractArchType \"^s\n  | ContractInstanceType s -> \"ContractInstanceType \"^s\n  | ReferenceType _ -> \"pointer to ...\"\n  | TupleType _ -> \"tuple\"\n\ntype arg =\n  { arg_typ : typ\n  ; arg_ident : string\n  ; arg_location : SideEffect.location option\n  }\n\ntype event_arg =\n  { event_arg_body : arg\n  ; event_arg_indexed : bool\n  }\n\ntype event =\n  { event_name : string\n  ; event_arguments : event_arg list\n  }\n\n\ntype 'exp_annot function_call =\n  { call_head : string\n  ; call_args : ('exp_annot exp) list\n  }\nand 'exp_annot message_info =\n  { message_value_info : 'exp_annot exp option\n  ; message_reentrance_info : 'exp_annot sentence list\n  }\nand 'exp_annot new_exp =\n  { new_head : string\n  ; new_args : 'exp_annot exp list\n  ; new_msg_info : 'exp_annot message_info\n  }\nand 'exp_annot send_exp =\n  { send_head_contract : 'exp_annot exp\n  ; send_head_method : string option\n  ; send_args : 'exp_annot exp list\n  ; send_msg_info : 'exp_annot message_info\n  }\nand 'exp_annot exp = 'exp_annot exp_inner * 'exp_annot\nand 'exp_annot exp_inner =\n  | TrueExp\n  | FalseExp\n  | DecLit256Exp of WrapBn.t\n  | DecLit8Exp of WrapBn.t\n  | NowExp\n  | FunctionCallExp of 'exp_annot function_call\n  | IdentifierExp of string\n  | ParenthExp of 'exp_annot exp\n  | NewExp of 'exp_annot new_exp\n  | SendExp of 'exp_annot send_exp\n  | LandExp of 'exp_annot exp * 'exp_annot exp\n  | LtExp of 'exp_annot exp * 'exp_annot exp\n  | GtExp of 'exp_annot exp * 'exp_annot exp\n  | NeqExp of 'exp_annot exp * 'exp_annot exp\n  | EqualityExp of 'exp_annot exp * 'exp_annot exp\n  | AddressExp of 'exp_annot exp\n  | NotExp of 'exp_annot exp\n  | ArrayAccessExp of 'exp_annot lexp\n  | ValueExp\n  | SenderExp\n  | ThisExp\n  | SingleDereferenceExp of 'exp_annot exp\n  | TupleDereferenceExp of 'exp_annot exp\n  | PlusExp of 'exp_annot exp * 'exp_annot exp\n  | MinusExp of 'exp_annot exp * 'exp_annot exp\n  | MultExp of 'exp_annot exp * 'exp_annot exp\n  | BalanceExp of 'exp_annot exp\nand 'exp_annot lexp =\n  | ArrayAccessLExp of 'exp_annot array_access\nand 'exp_annot array_access =\n  { array_access_array : 'exp_annot exp\n  ; array_access_index : 'exp_annot exp\n  }\nand 'exp_annot variable_init =\n  { variable_init_type : typ\n  ; variable_init_name : string\n  ; variable_init_value : 'exp_annot exp\n  }\nand 'exp_annot sentence =\n  | AbortSentence\n  | ReturnSentence of 'exp_annot return\n  | AssignmentSentence of 'exp_annot lexp * 'exp_annot exp\n  | VariableInitSentence of 'exp_annot variable_init\n  | IfThenOnly of 'exp_annot exp * 'exp_annot sentence list\n  | IfThenElse of 'exp_annot exp * 'exp_annot sentence list * 'exp_annot sentence list\n  | SelfdestructSentence of 'exp_annot exp\n  | ExpSentence of 'exp_annot exp\n  | LogSentence of string * 'exp_annot exp list * event option\nand 'exp_annot return =\n  { return_exp : 'exp_annot exp option\n  ; return_cont : 'exp_annot exp\n  }\n\nlet read_array_access (l : 'a lexp) =\n  match l with\n  | ArrayAccessLExp a -> a\n\nlet event_arg_of_arg (a : arg) (indexed : bool) : event_arg =\n  { event_arg_body = a\n  ; event_arg_indexed = indexed\n  }\n\nlet arg_of_event_arg e =\n  e.event_arg_body\n\nlet split_event_args (e : event) (args : 'a exp list) =\n  let indexed : bool list =\n    List.map (fun (a : event_arg) ->\n        a.event_arg_indexed) e.event_arguments in\n  let combined : ('a exp * bool) list =\n    List.combine args indexed in\n  let (is, ns) = List.partition snd combined in\n  (List.map fst is, List.map fst ns)\n\ntype 'exp_annot case_body =\n  'exp_annot sentence list\n\ntype usual_case_header =\n  { case_return_typ : typ list\n  ; case_name : string\n  ; case_arguments : arg list\n  }\n\ntype case_header =\n  | UsualCaseHeader of usual_case_header\n  | DefaultCaseHeader\n\ntype 'exp_annot case =\n  { case_header : case_header\n  ; case_body : 'exp_annot case_body\n  }\n\ntype 'exp_annot contract =\n  { contract_name : string\n  ; contract_arguments : arg list\n  ; contract_cases : 'exp_annot case list\n  }\n\ntype 'exp_annot toplevel =\n  | Contract of 'exp_annot contract\n  | Event of event\n\nlet contract_name_of_return_cont ((r, _) : 'exp exp) : string option =\n  match r with\n  | FunctionCallExp c -> Some c.call_head\n  | _ -> None\n\nlet case_header_arg_list (c : case_header) : arg list =\n  match c with\n  | UsualCaseHeader uch ->\n     uch.case_arguments\n  | DefaultCaseHeader -> []\n\nlet contract_name_of_instance ((_, (t, _)) : (typ * 'a) exp) =\n  match t with\n  | ContractInstanceType s -> s\n  | typ -> failwith\n             (\"seeking contract_name_of non-contract \"^(string_of_typ typ))\n\nlet string_of_exp_inner e =\n  match e with\n  | ThisExp -> \"this\"\n  | ArrayAccessExp _ -> \"a[idx]\"\n  | SendExp _ -> \"send\"\n  | NewExp _ -> \"new\"\n  | ParenthExp _ -> \"()\"\n  | IdentifierExp str -> \"ident \"^str\n  | FunctionCallExp _ -> \"call\"\n  | NowExp -> \"now\"\n  | SenderExp -> \"sender\"\n  | TrueExp -> \"true\"\n  | FalseExp -> \"false\"\n  | DecLit256Exp d -> \"declit \"^(WrapBn.string_of_big_int d)\n  | DecLit8Exp d -> \"declit \"^(WrapBn.string_of_big_int d)\n  | NotExp _ -> \"not\"\n  | NeqExp _ -> \"neq\"\n  | LandExp _ -> \"_ && _\"\n  | LtExp _ -> \"lt\"\n  | GtExp _ -> \"gt\"\n  | ValueExp -> \"value\"\n  | EqualityExp _ -> \"equality\"\n  | AddressExp _ -> \"address\"\n  | SingleDereferenceExp _ -> \"dereference of ...\"\n  | TupleDereferenceExp _ -> \"dereference of tuple...\"\n  | PlusExp (a, b) -> \"... + ...\"\n  | MinusExp (a, b) -> \"... - ...\"\n  | MultExp (a, b) -> \"... * ...\"\n  | BalanceExp _ -> \"balance\"\n\nlet is_mapping (typ : typ) =\n  match typ with\n  | Uint256Type\n  | Uint8Type\n  | Bytes32Type\n  | AddressType\n  | BoolType\n  | ReferenceType _\n  | TupleType _\n  | ContractArchType _\n  | ContractInstanceType _\n  | VoidType\n    -> false\n  | MappingType _ -> true\n\nlet count_plain_args (typs : typ list) =\n  List.length (List.filter (fun t -> not (is_mapping t)) typs)\n\nlet fits_in_one_storage_slot (typ : typ) =\n  match typ with\n  | Uint256Type\n  | Uint8Type\n  | Bytes32Type\n  | AddressType\n  | BoolType\n  | ContractInstanceType _\n  | MappingType _ -> true\n  | ReferenceType _ -> false\n  | TupleType _ -> false\n  | ContractArchType _ -> false\n  | VoidType -> false\n\nlet size_of_typ (* in bytes *) = function\n  | Uint256Type -> 32\n  | Uint8Type -> 1\n  | Bytes32Type -> 32\n  | AddressType -> 20\n  | BoolType -> 32\n  | ReferenceType _ -> 32\n  | TupleType lst ->\n     failwith \"size_of_typ Tuple\"\n  | MappingType _ -> failwith \"size_of_typ MappingType\" (* XXX: this is just 32 I think *)\n  | ContractArchType x -> failwith (\"size_of_typ ContractArchType: \"^x)\n  | ContractInstanceType _ -> 20 (* address as word *)\n  | VoidType -> failwith \"size_of_typ VoidType should not be asked\"\n\nlet calldata_size_of_typ (typ : typ) =\n  match typ with\n  | MappingType _ -> failwith \"mapping cannot be a case argument\"\n  | ReferenceType _ -> failwith \"reference type cannot be a case argument\"\n  | TupleType _ -> failwith \"tupletype not implemented\"\n  | ContractArchType _ -> failwith \"ContractArchType cannot be a case argument\"\n  | _ -> size_of_typ typ\n\nlet calldata_size_of_arg (arg : arg) =\n  calldata_size_of_typ arg.arg_typ\n\nlet is_throw_only (ss : typ sentence list) : bool =\n  match ss with\n  | [] -> false\n  | [AbortSentence] -> true\n  | _ -> false\n\nlet non_mapping_arg (arg : arg) =\n  match arg.arg_typ with\n  | MappingType _ -> false\n  | _ -> true\n\nlet rec functioncall_might_become f =\n  List.concat (List.map exp_might_become f.call_args)\nand new_exp_might_become n =\n  List.concat (List.map exp_might_become n.new_args)@\n    (msg_info_might_become n.new_msg_info)\nand msg_info_might_become m =\n  (match m.message_value_info with\n   | None -> []\n   | Some e -> exp_might_become e)@\n    [(* TODO: message_reentrance_info should contain a continuation! *)]\nand send_exp_might_become s =\n  (exp_might_become s.send_head_contract)@\n    (List.concat (List.map exp_might_become s.send_args))@\n      (msg_info_might_become s.send_msg_info)\nand array_access_might_become aa =\n  exp_might_become aa.array_access_index\nand exp_might_become e : string list =\n  match fst e with\n  | TrueExp -> []\n  | FalseExp -> []\n  | DecLit256Exp _ -> []\n  | DecLit8Exp _ -> []\n  | NowExp -> []\n  | FunctionCallExp f ->\n     functioncall_might_become f\n  | IdentifierExp _ -> []\n  | ParenthExp content ->\n     exp_might_become content\n  | NewExp n ->\n     new_exp_might_become n\n  | SendExp s ->\n     send_exp_might_become s\n  | LandExp (l, r) ->\n     (exp_might_become l)@(exp_might_become r)\n  | LtExp (l, r) ->\n     (exp_might_become l)@(exp_might_become r)\n  | GtExp (l, r) ->\n     (exp_might_become l)@(exp_might_become r)\n  | NeqExp (l, r) ->\n     (exp_might_become l)@(exp_might_become r)\n  | EqualityExp (l, r) ->\n     (exp_might_become l)@(exp_might_become r)\n  | AddressExp a ->\n     (exp_might_become a)\n  | NotExp n ->\n     exp_might_become n\n  | ArrayAccessExp aa ->\n     lexp_might_become aa\n  | ValueExp -> []\n  | SenderExp -> []\n  | ThisExp -> []\n  | SingleDereferenceExp e ->\n     exp_might_become e\n  | TupleDereferenceExp e ->\n     exp_might_become e\n  | MinusExp (a, b)\n  | MultExp (a, b)\n  | PlusExp (a, b) ->\n     (exp_might_become a)@(exp_might_become b)\n  | BalanceExp a ->\n     exp_might_become a\nand lexp_might_become l =\n  match l with\n  | ArrayAccessLExp aa ->\n     array_access_might_become aa\n\nlet variable_init_might_become v =\n  exp_might_become v.variable_init_value\n\nlet rec sentence_might_become (s : typ sentence) : string list =\n  match s with\n  | AbortSentence -> []\n  | ReturnSentence ret ->\n     (match ret.return_exp with\n      | Some e -> exp_might_become e\n      | None -> []) @\n       (exp_might_become ret.return_cont)@\n         (match contract_name_of_return_cont ret.return_cont with\n          | Some name -> [name]\n          | None -> []\n         )\n  | AssignmentSentence (l, r) ->\n     (lexp_might_become l)@\n       (exp_might_become r)\n  | VariableInitSentence v ->\n     variable_init_might_become v\n  | IfThenOnly (c, block) ->\n     (exp_might_become c)@(sentences_might_become block)\n  | IfThenElse (c, b0, b1) ->\n     (exp_might_become c)@(sentences_might_become b0)@(sentences_might_become b1)\n  | SelfdestructSentence e ->\n     exp_might_become e\n  | ExpSentence e ->\n     exp_might_become e\n  | LogSentence (_, lst, _) ->\n     exps_might_become lst\n\nand exps_might_become (lst : typ exp list) : string list =\n  List.concat (List.map exp_might_become lst)\n\nand sentences_might_become ss =\n  List.concat (List.map sentence_might_become ss)\n\n\nlet case_might_become (case : typ case) : string list =\n  let body = case.case_body in\n  List.concat (List.map sentence_might_become body)\n\nlet might_become (c : typ contract) : string list =\n  let cases = c.contract_cases in\n  List.concat (List.map case_might_become cases)\n\n\nlet lookup_usual_case_in_single_contract c case_name =\n  let cases = c.contract_cases in\n  let cases = List.filter (fun c -> match c.case_header with\n                                     | DefaultCaseHeader -> false\n                                     | UsualCaseHeader uc ->\n                                        uc.case_name = case_name) cases in\n  let () = if (List.length cases = 0) then\n             raise Not_found\n           else if (List.length cases > 1) then\n             let () = Printf.eprintf \"case %s duplicated\\n%!\" case_name in\n             failwith \"case_lookup\"\n  in\n  match cases with\n  | [] -> raise Not_found\n  | _ :: _ :: _ -> failwith \"should not happen\"\n  | [a] ->\n     begin match a.case_header with\n     | UsualCaseHeader uc -> uc\n     | DefaultCaseHeader -> failwith \"lookup_usual_case_in_single_contract: default case found\"\n     end\n\nlet rec lookup_usual_case_header_inner (already_seen : typ contract list)\n                                   (c : typ contract)\n                                   (case_name : string) f : usual_case_header =\n  if List.mem c already_seen then\n    raise Not_found\n  else\n    try\n      lookup_usual_case_in_single_contract c case_name\n    with Not_found ->\n         let already_seen = c :: already_seen in\n         let becomes = List.map f (might_become c) in\n         let rec try_becomes bs already_seen =\n           (match bs with\n            | [] -> raise Not_found\n            | h :: tl ->\n               (try\n                  lookup_usual_case_header_inner already_seen h case_name f\n                with Not_found ->\n                     let already_seen = h :: already_seen in\n                     try_becomes tl already_seen)) in\n         try_becomes becomes already_seen\n\nlet lookup_usual_case_header (c : typ contract) (case_name : string) f : usual_case_header =\n  lookup_usual_case_header_inner [] c case_name f\n\nlet size_of_typs (typs : typ list) =\n  WrapList.sum (List.map size_of_typ typs)\n\nlet acceptable_as t0 t1 =\n  (t0 = t1) ||\n    match t0, t1 with\n    | AddressType, ContractInstanceType _ -> true\n    | _, _ -> false\n"
  },
  {
    "path": "src/ast/syntax.mli",
    "content": "type typ =\n  | VoidType (** the result of calling address.default() *)\n  | Uint256Type\n  | Uint8Type\n  | Bytes32Type\n  | AddressType\n  | BoolType\n  | ReferenceType of typ list (** pointer to [typ list] on memory *)\n  | TupleType of typ list\n  | MappingType of typ * typ\n  | ContractArchType of string (* type of [bid(...)] where bid is a contract *)\n  | ContractInstanceType of string (* type of [b] declared as [bid b] *)\n\ntype arg =\n  { arg_typ : typ\n  ; arg_ident : string\n  ; arg_location : SideEffect.location option\n  }\n\ntype event_arg =\n  { event_arg_body : arg\n  ; event_arg_indexed : bool\n  }\n\ntype event =\n  { event_name : string\n  ; event_arguments : event_arg list\n  }\n\ntype 'exp_annot function_call =\n  {  call_head : string\n  ;  call_args : ('exp_annot exp) list\n  }\nand 'exp_annot message_info =\n  { message_value_info : 'exp_annot exp option\n  ; message_reentrance_info : 'exp_annot sentence list\n  }\nand 'exp_annot new_exp =\n  { new_head : string\n  ; new_args : 'exp_annot exp list\n  ; new_msg_info : 'exp_annot message_info\n  }\nand 'exp_annot send_exp =\n  { send_head_contract : 'exp_annot exp\n  ; send_head_method : string option (* None means default *)\n  ; send_args : 'exp_annot exp list\n  ; send_msg_info : 'exp_annot message_info\n  }\nand 'exp_annot exp = 'exp_annot exp_inner * 'exp_annot\nand 'exp_annot exp_inner =\n  | TrueExp\n  | FalseExp\n  | DecLit256Exp of WrapBn.t\n  | DecLit8Exp of WrapBn.t\n  | NowExp\n  | FunctionCallExp of 'exp_annot function_call\n  | IdentifierExp of string\n  | ParenthExp of 'exp_annot exp\n  | NewExp of 'exp_annot new_exp\n  | SendExp of 'exp_annot send_exp\n  | LandExp of 'exp_annot exp * 'exp_annot exp\n  | LtExp of 'exp_annot exp * 'exp_annot exp\n  | GtExp of 'exp_annot exp * 'exp_annot exp\n  | NeqExp of 'exp_annot exp * 'exp_annot exp\n  | EqualityExp of 'exp_annot exp * 'exp_annot exp\n  | AddressExp of 'exp_annot exp\n  | NotExp of 'exp_annot exp\n  | ArrayAccessExp of 'exp_annot lexp\n  | ValueExp\n  | SenderExp\n  | ThisExp\n  | SingleDereferenceExp of 'exp_annot exp\n  | TupleDereferenceExp of 'exp_annot exp\n  | PlusExp of 'exp_annot exp * 'exp_annot exp\n  | MinusExp of 'exp_annot exp * 'exp_annot exp\n  | MultExp of 'exp_annot exp * 'exp_annot exp\n  | BalanceExp of 'exp_annot exp\nand 'exp_annot lexp =\n  | ArrayAccessLExp of 'exp_annot array_access\nand 'exp_annot array_access =\n  { array_access_array : 'exp_annot exp\n  ; array_access_index : 'exp_annot exp\n  }\nand 'exp_annot variable_init =\n  { variable_init_type : typ\n  ; variable_init_name : string\n  ; variable_init_value : 'exp_annot exp\n  }\nand 'exp_annot sentence =\n  | AbortSentence\n  | ReturnSentence of 'exp_annot return\n  | AssignmentSentence of 'exp_annot lexp * 'exp_annot exp\n  | VariableInitSentence of 'exp_annot variable_init\n  | IfThenOnly of 'exp_annot exp * 'exp_annot sentence list\n  | IfThenElse of 'exp_annot exp * 'exp_annot sentence list * 'exp_annot sentence list\n  | SelfdestructSentence of 'exp_annot exp\n  | ExpSentence of 'exp_annot exp\n  | LogSentence of string * 'exp_annot exp list * event option\nand 'exp_annot return =\n  { return_exp : 'exp_annot exp option\n  ; return_cont : 'exp_annot exp\n  }\n\nval read_array_access : 'exp_annot lexp -> 'exp_annot array_access\n\nval event_arg_of_arg: arg -> bool -> event_arg\nval arg_of_event_arg: event_arg -> arg\n\ntype 'exp_annot case_body =\n  'exp_annot sentence list\n\ntype usual_case_header =\n  { case_return_typ : typ list\n  ; case_name : string\n  ; case_arguments : arg list\n  }\n\n(** [split_event_args event args] returns [(indexed_args, unindexed_args)] *)\nval split_event_args : event -> 'a exp list -> ('a exp list * 'a exp list)\n\ntype case_header =\n  | UsualCaseHeader of usual_case_header\n  | DefaultCaseHeader\n\ntype 'exp_annot case =\n  { case_header : case_header\n  ; case_body : 'exp_annot case_body\n  }\n\ntype 'exp_annot contract =\n  { contract_name : string\n  ; contract_arguments : arg list\n  ; contract_cases : 'exp_annot case list\n  }\n\ntype 'exp_annot toplevel =\n  | Contract of 'exp_annot contract\n  | Event of event\n\nval contract_name_of_return_cont : 'exp exp -> string option\n\nval case_header_arg_list : case_header -> arg list\n\nval contract_name_of_instance : (typ * 'x) exp -> string\n\nval string_of_typ : typ -> string\nval string_of_exp_inner : 'a exp_inner -> string\n\nval is_mapping : typ -> bool\nval count_plain_args : typ list -> int\n\nval fits_in_one_storage_slot : typ -> bool\nval calldata_size_of_arg : arg -> int\n\n(** [size_of_typ typ] is the number of bytes that a value of [typ] occupies *)\nval size_of_typ : typ -> int\n\n(** [size_of_typs typs] is the sum of [size_of_typ]s *)\nval size_of_typs : typ list -> int\n\nval is_throw_only : typ sentence list -> bool\n\nval non_mapping_arg : arg -> bool\n\n(** [lookup_usual_case_header c name f] looks up a case called\n    [name] in the contract [c].  [f] is a function that looks up a contract by its name. *)\nval lookup_usual_case_header : typ contract -> string -> (string -> typ contract) -> usual_case_header\n\n(** [might_become c] lists the name of the contracts that [c] might become, except [c] itself. *)\nval might_become : typ contract -> string list\n\n(** [acceptable_as wanted actual] is true when [actual] is acceptable as [wanted]. *)\nval acceptable_as : typ -> typ -> bool\n"
  },
  {
    "path": "src/ast/type.ml",
    "content": "open Syntax\n\n\nlet ident_lookup_type\n      (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n      (tenv : TypeEnv.type_env) id : (typ * SideEffect.t list) exp =\n  match TypeEnv.lookup tenv id with\n  | Some (typ, Some loc) -> (IdentifierExp id, (typ, [loc, SideEffect.Read]))\n  | Some (typ, None) -> (IdentifierExp id, (typ, []))\n  | None -> failwith (\"unknown identifier \"^id)\n  (* what should it return when it is a method name? *)\n\nlet is_known_contract contract_interfaces name =\n  List.exists (fun (_, i) -> i.Contract.contract_interface_name = name) contract_interfaces\n\nlet rec is_known_type (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc) (t : typ) =\n  Syntax.(\n    match t with\n    | Uint256Type -> true\n    | Uint8Type -> true\n    | Bytes32Type -> true\n    | AddressType -> true\n    | BoolType -> true\n    | ReferenceType lst ->\n       List.for_all (is_known_type contract_interfaces) lst\n    | TupleType lst ->\n       List.for_all (is_known_type contract_interfaces) lst\n    | MappingType (a, b) ->\n       is_known_type contract_interfaces a && is_known_type contract_interfaces b\n    | ContractArchType contract ->\n       is_known_contract contract_interfaces contract\n    | ContractInstanceType contract ->\n       is_known_contract contract_interfaces contract\n    | VoidType -> true\n  )\n\nlet arg_has_known_type contract_interfaces arg =\n  let ret = is_known_type contract_interfaces arg.arg_typ in\n  if not ret then Printf.eprintf \"argument has an unknown type %s\\n\" (Syntax.string_of_typ arg.arg_typ);\n  ret\n\nlet ret_type_is_known contract_interfaces header =\n  List.for_all (is_known_type contract_interfaces) header.case_return_typ\n\nlet assign_type_case_header contract_interfaces header =\n  match header with\n  | UsualCaseHeader header ->\n     let () = assert (List.for_all (arg_has_known_type contract_interfaces) header.case_arguments) in\n     let () = assert (ret_type_is_known contract_interfaces header) in\n     UsualCaseHeader header\n  | DefaultCaseHeader ->\n     DefaultCaseHeader\n\nlet call_arg_expectations (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc) mtd : typ list -> bool =\n  match mtd with\n  | \"pre_ecdsarecover\" ->\n     (fun x -> x = [Bytes32Type; Uint8Type; Bytes32Type; Bytes32Type])\n  | \"keccak256\" ->\n     (fun _ -> true)\n  | \"iszero\" ->\n     (fun x -> x = [Bytes32Type] || x = [Uint8Type] || x = [Uint256Type] || x = [BoolType] || x = [AddressType])\n  | name ->\n     let cid = Assoc.lookup_id (fun c -> c.Contract.contract_interface_name = name) contract_interfaces in\n     let interface : Contract.contract_interface = Assoc.choose_contract cid contract_interfaces in\n     (fun x -> x = interface.Contract.contract_interface_args)\n\nlet type_check ((exp : typ), ((_,(t, _)) : (typ * 'a) exp)) =\n  assert (exp = t)\n\nlet check_args_match (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc) (args : (typ * 'x) exp list) (call_head : string option) =\n  let expectations : typ list -> bool =\n    match call_head with\n    | Some mtd ->\n       call_arg_expectations contract_interfaces mtd\n    | None ->\n       (fun x -> x = [])\n  in\n  assert (expectations (List.map (fun x -> (fst (snd x))) args))\n\nlet typecheck_multiple (exps : typ list) (actual : (typ * 'a) exp list) =\n  List.for_all2 (fun e (_, (a, _)) -> e = a) exps actual\n\nlet check_only_one_side_effect (llst : SideEffect.t list list)  =\n  (* write-write *)\n  if List.length (List.filter (fun x ->\n                      List.exists (fun s -> snd s = SideEffect.Write) x\n                    ) llst) > 1 then\n    failwith \"more than one sub-expressions have side-effects\";\n  (* read-write *)\n  if List.length (List.filter (fun x ->\n                      List.exists (fun s -> snd s = SideEffect.Write) x\n                    ) llst) = 0 then ()\n  else\n  if List.length (List.filter (fun x ->\n                      List.exists (fun s -> snd s = SideEffect.Read) x\n                    ) llst) > 0 then\n    failwith \"some sub-expressions have write effects and some have read effects\"\n\nlet has_no_side_effects (e : (typ * SideEffect.t list) exp) =\n  snd (snd e) = []\n\nlet rec assign_type_call\n      contract_interfaces\n      cname\n      venv (src : unit function_call) : ((typ * SideEffect.t list) function_call * (typ * SideEffect.t list)) =\n  let args' = List.map (assign_type_exp contract_interfaces cname venv)\n                       src.call_args in\n  let () = check_args_match contract_interfaces args' (Some src.call_head) in\n  let args_side_effects : SideEffect.t list list = List.map (fun (_, (_, s)) -> s) args' in\n  let () = check_only_one_side_effect args_side_effects in\n  let side_effects = (SideEffect.External, SideEffect.Write) :: List.concat args_side_effects in\n  let ret_typ =\n    match src.call_head with\n    | \"value\" when true (* check the argument is 'msg' *) -> Uint256Type\n    | \"pre_ecdsarecover\" -> AddressType\n    | \"keccak256\" -> Bytes32Type\n    | \"iszero\" -> (match args' with\n                   | [arg] -> BoolType\n                   | _ -> failwith \"should not happen\")\n    | contract_name\n      when true (* check the contract exists*) -> ContractArchType contract_name\n    | _ -> failwith \"assign_type_call: should not happen\"\n    in\n  ({ call_head = src.call_head\n     ; call_args = args' },\n   (ret_typ, side_effects))\nand assign_type_message_info contract_interfaces cname tenv\n                             (orig : unit message_info) : (typ * SideEffect.t list) message_info =\n  let v' = WrapOption.map (assign_type_exp contract_interfaces cname tenv)\n                            orig.message_value_info in\n  let block' = assign_type_sentences contract_interfaces cname tenv orig.message_reentrance_info in\n  { message_value_info = v'\n  ; message_reentrance_info = block'\n  }\nand assign_type_exp\n      (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n      (cname : string)\n      (venv : TypeEnv.type_env) ((exp_inner, ()) : unit exp) : (typ * SideEffect.t list) exp =\n  match exp_inner with\n  | ThisExp -> (ThisExp, (ContractInstanceType cname, []))\n  | TrueExp -> (TrueExp, (BoolType, []))\n  | FalseExp -> (FalseExp, (BoolType, []))\n  | SenderExp -> (SenderExp, (AddressType, []))\n  | NowExp -> (NowExp, (Uint256Type, []))\n  | FunctionCallExp c ->\n     let (c', typ) = assign_type_call contract_interfaces cname venv c in\n     (FunctionCallExp c', typ)\n  | DecLit256Exp d -> (DecLit256Exp d, (Uint256Type, []))\n  | DecLit8Exp d -> (DecLit8Exp d, (Uint8Type, []))\n  | IdentifierExp s ->\n     (* Now something is strange. This might not need a type anyway. *)\n     (* Maybe introduce a type called CallableType *)\n     let () =\n       if WrapString.starts_with s \"pre_\" then\n         failwith \"names that start with pre_ are reserved\" in\n     ident_lookup_type contract_interfaces venv s\n  | ParenthExp e ->\n     (* omit the parenthesis at this place, the tree already contains the structure *)\n     assign_type_exp contract_interfaces cname venv e\n  | NewExp n ->\n     let (n', contract_name) = assign_type_new_exp contract_interfaces cname venv n in\n     let () =\n       if WrapString.starts_with contract_name \"pre_\" then\n         failwith \"names that start with pre_ are reserved\" in\n     (NewExp n', (ContractInstanceType contract_name, [SideEffect.External, SideEffect.Write]))\n  | LandExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let () = type_check (BoolType, l) in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let () = type_check (BoolType, r) in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l; r]) in\n     let () = check_only_one_side_effect sides in\n     (LandExp (l, r), (BoolType, List.concat sides))\n  | LtExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l; r]) in\n     let () = check_only_one_side_effect sides in\n     let () = assert (fst (snd l) = fst (snd r)) in\n     (LtExp (l, r), (BoolType, List.concat sides))\n  | GtExp (l, r) ->\n     let l' = assign_type_exp contract_interfaces cname venv l in\n     let r' = assign_type_exp contract_interfaces cname venv r in\n     let () = assert (fst (snd l') = fst (snd r')) in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l'; r']) in\n     let () = check_only_one_side_effect sides in\n     (GtExp (l', r'), (BoolType, List.concat sides))\n  | NeqExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let () = assert (fst (snd l) = fst (snd r)) in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l; r]) in\n     let () = check_only_one_side_effect sides in\n     (NeqExp (l, r), (BoolType, List.concat sides))\n  | EqualityExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let () = assert (fst (snd l) = fst (snd r)) in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l; r]) in\n     let () = check_only_one_side_effect sides in\n     (EqualityExp (l, r), (BoolType, List.concat sides))\n  | PlusExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let () = assert (fst (snd l) = fst (snd r)) in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l; r]) in\n     let () = check_only_one_side_effect sides in\n     (PlusExp (l, r), (fst (snd l), List.concat sides))\n  | MinusExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let () = assert (fst (snd l) = fst (snd r)) in\n     let sides = (List.map (fun (_, (_, x)) -> x) [l; r]) in\n     let () = check_only_one_side_effect sides in\n     (MinusExp (l, r), (fst (snd l), List.concat sides))\n  | MultExp (l, r) ->\n     let l = assign_type_exp contract_interfaces cname venv l in\n     let r = assign_type_exp contract_interfaces cname venv r in\n     let () = assert (fst (snd l) = fst (snd r)) in\n     (MultExp (l, r), snd l)\n  | NotExp negated ->\n     let negated = assign_type_exp contract_interfaces cname venv negated in\n     let () = assert (fst (snd negated) = BoolType) in\n     (NotExp negated, (BoolType, snd (snd negated)))\n  | AddressExp inner ->\n     let inner' = assign_type_exp contract_interfaces cname venv inner in\n     (AddressExp inner', (AddressType, snd (snd inner')))\n  | BalanceExp inner ->\n     let inner = assign_type_exp contract_interfaces cname venv inner in\n     let () = assert (acceptable_as AddressType (fst (snd inner))) in\n     let () = assert (snd (snd inner) = []) in\n     (BalanceExp inner, (Uint256Type, [SideEffect.External, SideEffect.Read]))\n  | ArrayAccessExp aa ->\n     let atyped = assign_type_exp contract_interfaces cname venv (read_array_access aa).array_access_array in\n     begin match fst (snd atyped) with\n     | MappingType (key_type, value_type) ->\n        let (idx', (idx_typ', idx_side')) = assign_type_exp contract_interfaces cname venv (read_array_access aa).array_access_index in\n        let () = assert (acceptable_as key_type idx_typ') in\n        let () = assert (List.for_all (fun x -> x = (SideEffect.Storage, SideEffect.Read)) idx_side') in\n        (* TODO Check idx_typ' and key_type are somehow compatible *)\n        (ArrayAccessExp (ArrayAccessLExp\n           { array_access_array = atyped\n           ; array_access_index = (idx', (idx_typ', idx_side'))\n           }), (value_type, [SideEffect.Storage, SideEffect.Read]))\n     | _ -> failwith \"index access has to be on mappings\"\n     end\n  | SendExp send ->\n     let msg_info' = assign_type_message_info contract_interfaces cname venv\n                                           send.send_msg_info in\n     let contract' = assign_type_exp contract_interfaces cname venv send.send_head_contract in\n     begin match send.send_head_method with\n     | Some mtd ->\n        let contract_name = Syntax.contract_name_of_instance contract' in\n        let method_sig : Ethereum.function_signature = begin\n            match Contract.find_method_signature\n                    contract_interfaces contract_name mtd with\n            | Some x -> x\n            | None -> failwith (\"method \"^mtd^\" not found\")\n          end\n        in\n        let types = Ethereum.(List.map to_typ (method_sig.sig_return)) in\n        let args = List.map (assign_type_exp contract_interfaces cname venv)\n                                     send.send_args in\n        let () = assert (List.for_all has_no_side_effects args) in\n        let reference : (Syntax.typ * SideEffect.t list) exp =\n          ( SendExp\n              { send_head_contract = contract'\n              ; send_head_method = send.send_head_method\n              ; send_args = args\n              ; send_msg_info = msg_info'\n              },\n            (ReferenceType types, [SideEffect.External, SideEffect.Write])\n          ) in\n        (match types with\n         | [single] -> (SingleDereferenceExp reference, (single, [SideEffect.External, SideEffect.Write]))\n         | _ -> reference)\n     | None ->\n        let () = assert (send.send_args = []) in\n        ( SendExp\n            { send_head_contract = contract'\n            ; send_head_method = None\n            ; send_args = []\n            ; send_msg_info = msg_info'\n            }, (VoidType, [SideEffect.External, SideEffect.Write]) )\n     end\n  | ValueExp ->\n     (ValueExp, (Uint256Type, []))\n  | SingleDereferenceExp _\n  | TupleDereferenceExp _ ->\n     failwith \"DereferenceExp not supposed to appear in the raw tree for now\"\nand assign_type_new_exp\n      contract_interfaces\n      (cname : string)\n      (tenv : TypeEnv.type_env)\n      (e : unit new_exp) : ((typ * SideEffect.t list) new_exp * string (* name of the contract just created *)) =\n  let msg_info' = assign_type_message_info contract_interfaces\n                                           cname tenv e.new_msg_info in\n  let args' = List.map (assign_type_exp contract_interfaces cname tenv) e.new_args in\n  let e' =\n    { new_head = e.new_head\n    ; new_args = args'\n    ; new_msg_info = msg_info'\n    }\n  in\n  (e',\n   e.new_head\n  )\nand assign_type_lexp\n      contract_interfaces\n      (cname : string)\n      venv (src : unit lexp) : (typ * SideEffect.t list) lexp =\n  (* no need to type the left hand side? *)\n  match src with\n  | ArrayAccessLExp aa ->\n     let atyped = assign_type_exp contract_interfaces cname venv aa.array_access_array in\n     begin match fst (snd atyped) with\n     | MappingType (key_type, value_type) ->\n        let (idx', idx_typ') = assign_type_exp contract_interfaces\n                                               cname venv\n                                               aa.array_access_index in\n        (* TODO Check idx_typ' and key_type are somehow compatible *)\n        (ArrayAccessLExp\n           { array_access_array = atyped\n           ; array_access_index = (idx', idx_typ')})\n     | _ -> failwith (\"unknown array\")\n     end\nand assign_type_return\n      (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n      (cname : string)\n      (tenv : TypeEnv.type_env)\n      (src : unit return) : (typ * SideEffect.t list) return =\n  let exps = WrapOption.map (assign_type_exp contract_interfaces\n                                   cname tenv) src.return_exp in\n  let f = TypeEnv.lookup_expected_returns tenv in\n  let () = assert (f (WrapOption.map (fun x -> (fst (snd x))) exps)) in\n  { return_exp = exps\n  ; return_cont =  assign_type_exp contract_interfaces\n                                   cname tenv src.return_cont\n  }\nand type_variable_init\n      contract_interfaces cname tenv (vi : unit variable_init) :\n      ((typ * SideEffect.t list) variable_init * TypeEnv.type_env) =\n  (* This function has to enlarge the type environment *)\n  let value' = assign_type_exp contract_interfaces\n                               cname tenv vi.variable_init_value in\n  let added_name = vi.variable_init_name in\n  let () =\n    if WrapString.starts_with added_name \"pre_\" then\n      failwith \"names that start with pre_ are reserved\" in\n  let added_typ = vi.variable_init_type in\n  let () = assert (is_known_type contract_interfaces added_typ) in\n  let new_env = TypeEnv.add_pair tenv added_name added_typ None in\n  let new_init =\n    { variable_init_type = added_typ\n    ; variable_init_name = added_name\n    ; variable_init_value = value'\n    } in\n  (new_init, new_env)\nand assign_type_sentence\n      (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n      (cname : string)\n      (venv : TypeEnv.type_env)\n      (src : unit sentence) :\n      ((typ * SideEffect.t list) sentence * TypeEnv.type_env (* updated environment *)) =\n  match src with\n  | AbortSentence -> (AbortSentence, venv)\n  | ReturnSentence r ->\n     let r' =\n       assign_type_return contract_interfaces cname venv r in\n     (ReturnSentence r', venv)\n  | AssignmentSentence (l, r) ->\n     let l' = assign_type_lexp contract_interfaces cname venv l in\n     let r' = assign_type_exp contract_interfaces cname venv r in\n     (AssignmentSentence (l', r'), venv)\n  | IfThenOnly (cond, ss) ->\n     let cond' = assign_type_exp contract_interfaces cname venv cond in\n     let ss'\n       = assign_type_sentences\n           contract_interfaces cname venv ss in\n     (IfThenOnly (cond', ss'), venv)\n  | IfThenElse (cond, sst, ssf) ->\n     let cond' = assign_type_exp contract_interfaces cname venv cond in\n     let sst' = assign_type_sentences contract_interfaces cname venv sst in\n     let ssf' = assign_type_sentences contract_interfaces cname venv ssf in\n     (IfThenElse (cond', sst', ssf'), venv)\n  | SelfdestructSentence e ->\n     let e' = assign_type_exp contract_interfaces cname venv e in\n     (SelfdestructSentence e', venv)\n  | VariableInitSentence vi ->\n     let (vi', venv') =  type_variable_init contract_interfaces cname venv vi in\n     (VariableInitSentence vi', venv')\n  | ExpSentence exp ->\n     let exp = assign_type_exp contract_interfaces cname venv exp in\n     let () = assert (fst (snd exp) = VoidType) in\n     let () = assert (List.exists (fun (_, x) -> x = SideEffect.Write) (snd (snd exp))) in\n     (ExpSentence exp, venv)\n  | LogSentence (name, args, _) ->\n     let args = List.map (assign_type_exp contract_interfaces cname venv) args in\n     let event = TypeEnv.lookup_event venv name in\n     let type_expectations =\n       List.map (fun ea -> Syntax.(ea.event_arg_body.arg_typ)) event.Syntax.event_arguments in\n     let () = assert (typecheck_multiple type_expectations args) in\n     let side_effects = List.map (fun (_, (_, a)) -> a) args in\n     let () = check_only_one_side_effect side_effects in\n     (LogSentence (name, args, Some event), venv)\n\nand assign_type_sentences\n          (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n          (cname : string)\n          (type_environment : TypeEnv.type_env)\n          (ss : unit sentence list) : (typ * SideEffect.t list) sentence list =\n  match ss with\n  | [] -> []\n  | first_s :: rest_ss ->\n     let (first_s', (updated_environment : TypeEnv.type_env)) =\n       assign_type_sentence\n         contract_interfaces cname type_environment first_s in\n     first_s' :: assign_type_sentences contract_interfaces\n                                       cname\n                                       updated_environment\n                                       rest_ss\n\ntype termination =\n  RunAway | ReturnValues of int | JustStop\n\nlet rec is_terminating_sentence (s : unit sentence) : termination list =\n  match s with\n  | AbortSentence -> [JustStop]\n  | ReturnSentence ret ->\n     begin match ret.return_exp with\n     | Some _ -> [ReturnValues 1]\n     | None -> [ReturnValues 0]\n     end\n  | AssignmentSentence _ -> [RunAway]\n  | VariableInitSentence _ -> [RunAway]\n  | IfThenOnly (_, b) -> (are_terminating b) @ [RunAway] (* there is a continuation if the condition does not hold. *)\n  | IfThenElse (_, bT, bF) -> are_terminating bT @ (are_terminating bF)\n  | SelfdestructSentence _ -> [JustStop]\n  | ExpSentence _ -> [RunAway]\n  | LogSentence _ -> [RunAway]\n\n(** [check_termination sentences] make sure that the last sentence in [sentences]\n *  cuts the continuation. *)\nand are_terminating sentences =\n  let last_sentence = WrapList.last sentences in\n  is_terminating_sentence last_sentence\n\nlet case_is_returning_void (case : unit case) : bool =\n  match case.case_header with\n  | DefaultCaseHeader -> true\n  | UsualCaseHeader u ->\n     u.case_return_typ = []\n\nlet return_expectation_of_case (h : Syntax.case_header) (actual : Syntax.typ option) : bool =\n  match h, actual with\n  | DefaultCaseHeader, Some _ -> false\n  | DefaultCaseHeader, None -> true\n  | UsualCaseHeader u, _ ->\n     begin match u.case_return_typ, actual with\n     | _ :: _ :: _, _ -> false\n     | [x], Some y -> Syntax.acceptable_as x y\n     | [], None -> true\n     | _, _ ->false\n     end\n\nlet assign_type_case (contract_interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n                     (contract_name : string)\n                     (venv : TypeEnv.type_env)\n                     (case : unit case) =\n  let () = assert (List.for_all (fun t ->\n                       match t with\n                       | RunAway -> false\n                       | ReturnValues 0 ->\n                          case_is_returning_void case\n                       | ReturnValues 1 ->\n                          not (case_is_returning_void case)\n                       | ReturnValues _ ->\n                          failwith \"returning multiple values not supported yet\"\n                       | JustStop -> true\n                     ) (are_terminating case.case_body)) in\n  let case_arguments = case_header_arg_list case.case_header in\n  let () =\n    if List.exists (fun arg -> WrapString.starts_with arg.arg_ident \"pre_\") case_arguments then\n      failwith \"names that start with pre_ are reserved\" in\n  let returns : Syntax.typ option -> bool = return_expectation_of_case case.case_header in\n  { case_header = assign_type_case_header contract_interfaces case.case_header\n  ; case_body = assign_type_sentences\n                  contract_interfaces\n                  contract_name\n                  (TypeEnv.remember_expected_returns (TypeEnv.add_block case_arguments venv) returns)\n                  case.case_body\n  }\n\nlet has_distinct_signatures (c : unit Syntax.contract) : bool =\n  let cases = c.contract_cases in\n  let signatures = List.map\n                     (fun c ->\n                       match c.case_header with\n                       | UsualCaseHeader u -> Some (Ethereum.case_header_signature_string u)\n                       | DefaultCaseHeader -> None) cases in\n  let unique_sig = WrapList.unique signatures in\n  List.length signatures = List.length unique_sig\n\n\nlet assign_type_contract (env : Contract.contract_interface Assoc.contract_id_assoc)\n                         (events: event Assoc.contract_id_assoc)\n      (raw : unit Syntax.contract) :\n      (Syntax.typ * SideEffect.t list) Syntax.contract =\n  let () = assert (List.for_all (arg_has_known_type env) raw.contract_arguments) in\n  let () = assert (has_distinct_signatures raw) in\n  let tenv = TypeEnv.(add_block raw.contract_arguments (add_events events empty_type_env)) in\n  let () =\n    if WrapString.starts_with raw.contract_name \"pre_\" then\n      failwith \"names that start with pre_ are reserved\" in\n  let () =\n    if List.exists (fun arg -> WrapString.starts_with arg.arg_ident \"pre_\") raw.contract_arguments then\n      failwith \"names that start with pre_ are reserved\" in\n  { contract_name = raw.contract_name\n  ; contract_arguments = raw.contract_arguments\n  ; contract_cases =\n      List.map (assign_type_case env raw.contract_name tenv) raw.contract_cases\n  }\n\nlet assign_type_toplevel (interfaces : Contract.contract_interface Assoc.contract_id_assoc)\n                         (events : event Assoc.contract_id_assoc)\n                         (raw : unit Syntax.toplevel) :\n      (Syntax.typ * SideEffect.t list) Syntax.toplevel =\n  match raw with\n  | Contract c ->\n     Contract (assign_type_contract interfaces events c)\n  | Event e ->\n     Event e\n\n(* XXX: these [strip_side_effects_X] should be generalized over any f : 'a -> 'b *)\n\nlet rec strip_side_effects_sentence (raw : (typ * 'a) sentence) : typ sentence =\n  match raw with\n  | AbortSentence -> AbortSentence\n  | ReturnSentence ret -> ReturnSentence (strip_side_effects_return ret)\n  | AssignmentSentence (l, r) ->\n     AssignmentSentence (strip_side_effects_lexp l, strip_side_effects_exp r)\n  | VariableInitSentence v ->\n     VariableInitSentence (strip_side_effects_variable_init v)\n  | IfThenOnly (e, block) ->\n     IfThenOnly (strip_side_effects_exp e, strip_side_effects_case_body block)\n  | IfThenElse (e, b0, b1) ->\n     IfThenElse ((strip_side_effects_exp e), (strip_side_effects_case_body b0),\n                 (strip_side_effects_case_body b1))\n  | SelfdestructSentence e ->\n     SelfdestructSentence (strip_side_effects_exp e)\n  | ExpSentence e ->\n     ExpSentence (strip_side_effects_exp e)\n  | LogSentence (str, args, eopt) ->\n     LogSentence (str, List.map strip_side_effects_exp args, eopt)\nand strip_side_effects_variable_init v =\n  { variable_init_type = v.variable_init_type\n  ; variable_init_name = v.variable_init_name\n  ; variable_init_value = strip_side_effects_exp v.variable_init_value\n  }\nand strip_side_effects_aa aa =\n  { array_access_array = strip_side_effects_exp aa.array_access_array\n  ; array_access_index = strip_side_effects_exp aa.array_access_index\n  }\nand strip_side_effects_lexp lexp =\n  match lexp with\n  | ArrayAccessLExp aa ->\n     ArrayAccessLExp (strip_side_effects_aa aa)\nand strip_side_effects_exp (i, (t, _)) =\n  (strip_side_effects_exp_inner i, t)\nand strip_side_effects_function_call fc =\n  { call_head = fc.call_head\n  ; call_args = List.map strip_side_effects_exp fc.call_args\n  }\nand strip_side_effects_msg_info m =\n  { message_value_info = WrapOption.map strip_side_effects_exp m.message_value_info\n  ; message_reentrance_info =\n      List.map strip_side_effects_sentence m.message_reentrance_info\n  }\nand strip_side_effects_send s =\n  { send_head_contract = strip_side_effects_exp s.send_head_contract\n  ; send_head_method = s.send_head_method\n  ; send_args = List.map strip_side_effects_exp s.send_args\n  ; send_msg_info = strip_side_effects_msg_info s.send_msg_info\n  }\nand strip_side_effects_new_exp n =\n  { new_head = n.new_head\n  ; new_args = List.map strip_side_effects_exp n.new_args\n  ; new_msg_info = strip_side_effects_msg_info n.new_msg_info\n  }\nand strip_side_effects_exp_inner i =\n  match i with\n  | TrueExp -> TrueExp\n  | FalseExp -> FalseExp\n  | DecLit256Exp d -> DecLit256Exp d\n  | DecLit8Exp d -> DecLit8Exp d\n  | NowExp -> NowExp\n  | FunctionCallExp fc ->\n     FunctionCallExp (strip_side_effects_function_call fc)\n  | IdentifierExp str ->\n     IdentifierExp str\n  | ParenthExp e ->\n     ParenthExp (strip_side_effects_exp e)\n  | NewExp e ->\n     NewExp (strip_side_effects_new_exp e)\n  | SendExp send ->\n     SendExp (strip_side_effects_send send)\n  | LandExp (a, b) ->\n     LandExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | LtExp (a, b) ->\n     LtExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | GtExp (a, b) ->\n     GtExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | NeqExp (a, b) ->\n     NeqExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | EqualityExp (a, b) ->\n     EqualityExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | AddressExp a ->\n     AddressExp (strip_side_effects_exp a)\n  | NotExp e ->\n     NotExp (strip_side_effects_exp e)\n  | ArrayAccessExp l ->\n     ArrayAccessExp (strip_side_effects_lexp l)\n  | ValueExp -> ValueExp\n  | SenderExp -> SenderExp\n  | ThisExp -> ThisExp\n  | SingleDereferenceExp e ->\n     SingleDereferenceExp (strip_side_effects_exp e)\n  | TupleDereferenceExp e ->\n     TupleDereferenceExp (strip_side_effects_exp e)\n  | PlusExp (a, b) ->\n     PlusExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | MinusExp (a, b) ->\n     MinusExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | MultExp (a, b) ->\n     MultExp (strip_side_effects_exp a, strip_side_effects_exp b)\n  | BalanceExp e ->\n     BalanceExp (strip_side_effects_exp e)\nand strip_side_effects_return ret =\n  { return_exp = WrapOption.map strip_side_effects_exp ret.return_exp\n  ; return_cont = strip_side_effects_exp ret.return_cont\n  }\nand strip_side_effects_case_body (raw : (typ * 'a) case_body) : typ case_body =\n  List.map strip_side_effects_sentence raw\n\nlet strip_side_effects_case (raw : (typ * 'a) case) : typ case =\n  { case_header = raw.case_header\n  ; case_body = strip_side_effects_case_body raw.case_body\n  }\n\nlet strip_side_effects_contract (raw : (typ * 'a) contract) : typ contract =\n  { contract_name = raw.contract_name\n  ; contract_arguments = raw.contract_arguments\n  ; contract_cases = List.map strip_side_effects_case raw.contract_cases\n  }\n\nlet strip_side_effects (raw : (typ * 'a) Syntax.toplevel) : typ Syntax.toplevel =\n  match raw with\n  | Contract c ->\n     Contract (strip_side_effects_contract c)\n  | Event e -> Event e\n\nlet has_distinct_contract_names (contracts : unit Syntax.contract Assoc.contract_id_assoc) : bool =\n  let contract_names = (List.map (fun (_, b) -> b.Syntax.contract_name) contracts) in\n  List.length contracts = List.length (WrapList.unique contract_names)\n\nlet assign_types (raw : unit Syntax.toplevel Assoc.contract_id_assoc) :\n      Syntax.typ Syntax.toplevel Assoc.contract_id_assoc =\n  let raw_contracts : unit Syntax.contract Assoc.contract_id_assoc =\n    Assoc.filter_map (fun x ->\n                          match x with\n                          | Contract c -> Some c\n                          | _ -> None\n                        ) raw in\n  let () = assert(has_distinct_contract_names(raw_contracts)) in\n  let interfaces = Assoc.map Contract.contract_interface_of raw_contracts in\n  let events : event Assoc.contract_id_assoc =\n    Assoc.filter_map (fun x ->\n        match x with\n        | Event e -> Some e\n        | _ -> None) raw in\n  Assoc.map strip_side_effects\n    (Assoc.map (assign_type_toplevel interfaces events) raw)\n"
  },
  {
    "path": "src/ast/type.mli",
    "content": "val assign_types :\n  unit Syntax.toplevel Assoc.contract_id_assoc -> Syntax.typ Syntax.toplevel Assoc.contract_id_assoc\n"
  },
  {
    "path": "src/ast/typeEnv.ml",
    "content": "(** The first element is the context for the innermost block *)\ntype type_env =\n  { identifiers: Syntax.arg list list\n  ; events: Syntax.event list\n  ; expected_returns : (Syntax.typ option -> bool) option\n  }\n\nlet empty_type_env : type_env =\n  { identifiers = []\n  ; events = []\n  ; expected_returns = None\n  }\n\nlet forget_innermost (orig : type_env) : type_env =\n  { orig with identifiers = List.tl (orig.identifiers) }\n\nlet add_empty_block (orig : type_env) : type_env =\n  { orig with identifiers = [] :: orig.identifiers }\n\nlet add_pair (orig : type_env) (ident : string) (typ : Syntax.typ) (loc : SideEffect.location option) : type_env =\n  match orig.identifiers with\n  | h :: t ->\n     { orig with identifiers = (Syntax.{ arg_ident = ident; arg_typ = typ; arg_location = loc} :: h) :: t }\n  | _ -> failwith \"no current scope in type env\"\n\nlet lookup_block (name : string) (block : Syntax.arg list) =\n  Misc.first_some\n    (fun (a : Syntax.arg) ->\n      if a.Syntax.arg_ident = name then Some (a.Syntax.arg_typ, a.Syntax.arg_location) else None)\n    block\n\nlet lookup (env : type_env) (name : string) : (Syntax.typ * SideEffect.location option) option =\n  Misc.first_some (lookup_block name) env.identifiers\n\nlet add_block (h : Syntax.arg list) (orig : type_env) : type_env =\n  { orig with identifiers = h :: orig.identifiers }\n\nlet lookup_event (env : type_env) (name : string) : Syntax.event =\n  try\n    List.find (fun e -> e.Syntax.event_name = name) env.events\n  with Not_found ->\n    let () = Printf.eprintf \"event %s not found\\n\" name in\n    raise Not_found\n\nlet add_events (events : Syntax.event Assoc.contract_id_assoc) (orig : type_env) : type_env =\n  { orig with events = (Assoc.values events) @ orig.events }\n\nlet remember_expected_returns (orig : type_env) f =\n  match orig.expected_returns with\n  | Some _ -> failwith \"Trying to overwrite the expectations about the return values\"\n  | None -> { orig with expected_returns = Some f }\n\nlet lookup_expected_returns t =\n  match t.expected_returns with\n  | None -> failwith \"undefined\"\n  | Some f -> f\n"
  },
  {
    "path": "src/ast/typeEnv.mli",
    "content": "type type_env\n\nval empty_type_env : type_env\nval forget_innermost : type_env -> type_env\nval add_empty_block : type_env -> type_env\nval add_pair : type_env -> string -> Syntax.typ -> SideEffect.location option -> type_env\nval lookup : type_env -> string -> (Syntax.typ * SideEffect.location option) option\nval add_block : Syntax.arg list -> type_env -> type_env\nval lookup_event : type_env -> string -> Syntax.event\nval add_events : Syntax.event Assoc.contract_id_assoc -> type_env -> type_env\nval remember_expected_returns : type_env -> (Syntax.typ option -> bool) -> type_env\nval lookup_expected_returns : type_env -> (Syntax.typ option -> bool)\n"
  },
  {
    "path": "src/basics/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 3b4490fa7dbdc2ad5da8665d7c5224d8)\nversion = \"0.0.03\"\ndescription = \"A compiler targeting Ethereum Virtual Machine\"\nrequires = \"cross-platform\"\narchive(byte) = \"basics.cma\"\narchive(byte, plugin) = \"basics.cma\"\narchive(native) = \"basics.cmxa\"\narchive(native, plugin) = \"basics.cmxs\"\nexists_if = \"basics.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/basics/assoc.ml",
    "content": "type contract_id = int\n\ntype 'a contract_id_assoc = (contract_id * 'a) list\n\nlet list_to_contract_id_assoc (lst : 'a list) =\n  let ids =\n    if lst = [] then\n      []\n    else\n      WrapList.range 0 (List.length lst - 1) in\n  List.combine ids lst\n\nlet map f lst =\n  List.map (fun (id, x) -> (id, f x)) lst\n\nlet pair_map f lst =\n  List.map (fun (id, x) -> (id, f id x)) lst\n\nlet filter_map f lst =\n  WrapList.filter_map (\n      fun (id, x) ->\n      WrapOption.map (fun ret -> (id, ret)) (f x)) lst\n\nlet choose_contract (id : contract_id) lst =\n  try\n    List.assoc id lst\n  with Not_found ->\n       let () = Printf.eprintf \"choose_contract: not_found\\n%!\" in\n       raise Not_found\n\nlet print_int_for_cids (f : contract_id -> int) (cids : contract_id list) : unit =\n  List.iter (fun cid -> Printf.printf \"%d |-> %d, \" cid (f cid)) cids\n\nlet insert (id : contract_id) (a : 'x) (orig : 'x contract_id_assoc) : 'x contract_id_assoc =\n  (id, a)::orig (* shall I sort it?  Maybe later at once. *)\n\nlet lookup_id (f : 'x -> bool) (lst : 'x contract_id_assoc) : contract_id =\n  let (id, _) = List.find (fun (_, x) -> f x) lst in\n  id\n\nlet empty = []\n\nlet cids lst = List.map fst lst\n\nlet values lst = List.map snd lst\n"
  },
  {
    "path": "src/basics/assoc.mli",
    "content": "type contract_id = int\n(* Currently, the location in [contracts] *)\n\ntype 'a contract_id_assoc = (contract_id * 'a) list\n\n(** [list_to_contract_id_assoc] assignes a different contract_id for each element of the list.\n *  It starts with 0 until (length of list - 1).\n *)\nval list_to_contract_id_assoc : 'a list -> 'a contract_id_assoc\n\nval map : ('a -> 'b) -> 'a contract_id_assoc -> 'b contract_id_assoc\nval pair_map : (contract_id -> 'a -> 'b) -> 'a contract_id_assoc -> 'b contract_id_assoc\nval filter_map : ('a -> 'b option) -> 'a contract_id_assoc -> 'b contract_id_assoc\n\nval choose_contract : contract_id -> 'x contract_id_assoc -> 'x\n\nval print_int_for_cids : (contract_id -> int) -> contract_id list -> unit\n\nval insert : contract_id -> 'x -> 'x contract_id_assoc -> 'x contract_id_assoc\n\nval lookup_id : ('x -> bool) -> 'x contract_id_assoc -> contract_id\n\nval empty : 'x contract_id_assoc\n\nval cids : 'x contract_id_assoc -> contract_id list\n\nval values : 'x contract_id_assoc -> 'x list\n"
  },
  {
    "path": "src/basics/basics.mldylib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 544c3466c83774053c2a71824a587891)\nAssoc\nHexa\nLabel\nMisc\nStorage\n# OASIS_STOP\n"
  },
  {
    "path": "src/basics/basics.mllib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 544c3466c83774053c2a71824a587891)\nAssoc\nHexa\nLabel\nMisc\nStorage\n# OASIS_STOP\n"
  },
  {
    "path": "src/basics/hex_test.ml",
    "content": "open Hexa\nopen Evm\n\nlet _ =\n  let () = Printf.printf \"testing hex\\n\" in\n  let () = assert (string_of_hex empty_hex = \"\") in\n  let one_hex = hex_of_big_int WrapBn.(big_int_of_int 1) 1 in\n  let () = assert (string_of_hex one_hex = \"01\") in\n  let () = assert (string_of_hex (concat_hex one_hex one_hex) = \"0101\") in\n  let () = assert (length_of_hex one_hex = 1) in\n  let () = assert (string_of_hex (hex_of_instruction STOP) = \"00\") in\n  let () = assert (string_of_hex (hex_of_program [STOP; RETURN]) = \"f300\") in\n  ()\n"
  },
  {
    "path": "src/basics/hexa.ml",
    "content": "type hex = Rope.t\n\nlet empty_hex = Rope.empty\nlet concat_hex = Rope.concat2\nlet length_of_hex h = Rope.length h / 2\nlet hex_of_big_int (b : WrapBn.t) (length : int) =\n  let raw = WrapBn.to_string_in_hexa b in\n  let char_limit = 2 * length in\n  let () =\n    if String.length raw > char_limit then failwith \"hex_of_big_int: too big\" in\n  let missing_len = char_limit - String.length raw in\n  let prefix = String.make missing_len '0' in\n  concat_hex (Rope.of_string prefix) (Rope.of_string raw)\n\nlet string_of_hex ?prefix:(prefix : string = \"\") (h : hex) : string =\n  let ret = concat_hex (Rope.of_string prefix) h in\n  Rope.to_string ret\n\nlet print_hex ?prefix:(prefix = \"\") h =\n  Printf.printf \"%s\\n\" (string_of_hex ~prefix h)\n\nlet hex_of_string s =\n  (* TODO: check if the string contains only 0-9a-fA-F *)\n  Rope.of_string s\n"
  },
  {
    "path": "src/basics/hexa.mli",
    "content": "type hex\n\nval empty_hex : hex\nval concat_hex : hex -> hex -> hex\n\n(** [length_of_hex h] returns the length of [h] as the number of the represented bytes.\n *  This implies [length_of_hex h] is always the half of the length of [string_of_hex h]. *)\nval length_of_hex : hex -> int\n\n(** [hex_of_big_int b l] returns the hex, which is zero-padded to [2 * l] characters.\n *  If [b] is too big, raises a failure.\n *)\nval hex_of_big_int : WrapBn.t -> int -> hex\n\n(** [hex_of_string \"0101\"] is the hex \"0x0101\" *)\nval hex_of_string : string -> hex\nval string_of_hex : ?prefix:string -> hex -> string\nval print_hex : ?prefix:string -> hex -> unit\n"
  },
  {
    "path": "src/basics/label.ml",
    "content": "type label = int\n\nlet debug_label = false\n\n(* internal data not accessible from outside of the module. *)\nlet next_fresh_label : int ref = ref 0\nlet store : (label * int) list ref = ref []\n\nlet new_label () =\n  let ret = !next_fresh_label in\n  let () = if debug_label then Printf.printf \"label: generating label %d\\n\" ret else () in\n  let () = next_fresh_label := ret + 1 in\n  ret\n\nlet register_value l i =\n  let () = if debug_label then Printf.printf \"label: registering label %d %d\\n%!\" l i in\n  store := (l, i) :: !store\n\nlet lookup_value l =\n  try\n    List.assoc l !store\n  with Not_found ->\n    let () = if debug_label then Printf.eprintf \"label: %d not found\\n%!\" l in\n    raise Not_found\n"
  },
  {
    "path": "src/basics/label.mli",
    "content": "(* A label is typically put on a jump destination.\n *)\n\ntype label\n\n(** [new label ()] returns a new label each time it is called. *)\nval new_label : unit -> label\n\n(** [register_value l i] registers a correspondence (l, i).\n *   If [register_location l j] is already called\n *   (even if j is equal to i), throws a failure *)\nval register_value : label -> int -> unit\n\n(** [lookup_value l] returns the value [i] with which\n * the correspondence [(l, i)] has been registered.\n * When such correspondence does not exist,\n * throws a failure.\n *)\nval lookup_value : label -> int\n"
  },
  {
    "path": "src/basics/misc.ml",
    "content": "let rec first_some f lst =\n  match lst with\n  | [] -> None\n  | h :: t ->\n     begin match f h with\n     | None -> first_some f t\n     | Some x -> Some x\n     end\n\nlet rec change_first f lst =\n  match lst with\n  | [] -> None\n  | h :: t ->\n     begin match f h with\n     | None ->\n       WrapOption.map (fun rest  -> h :: rest)\n                  (change_first f t)\n     | Some n -> Some (n :: t)\n     end\n"
  },
  {
    "path": "src/basics/misc.mli",
    "content": "(** If any element is mapped to [Some x], return the first such one. Otherwise return [None]. *)\nval first_some : ('a -> 'b option) -> 'a list -> 'b option\n\n(** If any element is mapped to [Some x], replace the first such element with [x].  Otherwise, return [None] *)\nval change_first : ('a -> 'a option) -> 'a list -> 'a list option\n"
  },
  {
    "path": "src/basics/storage.ml",
    "content": "type storage_location = int\n"
  },
  {
    "path": "src/basics/storage.mli",
    "content": "type storage_location = int\n"
  },
  {
    "path": "src/codegen/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 5601d8fffa94038ded43ae8629ffa980)\nversion = \"0.0.03\"\ndescription = \"A compiler targeting Ethereum Virtual Machine\"\nrequires = \"basics ast parse\"\narchive(byte) = \"codegen.cma\"\narchive(byte, plugin) = \"codegen.cma\"\narchive(native) = \"codegen.cmxa\"\narchive(native, plugin) = \"codegen.cmxs\"\nexists_if = \"codegen.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/codegen/codegen.ml",
    "content": "open PseudoImm\nopen CodegenEnv\nopen Evm\nopen Syntax\n\nlet copy_storage_range_to_stack_top le ce (range : PseudoImm.pseudo_imm Location.storage_range) =\n  let () = assert (PseudoImm.is_constant_int 1 range.Location.storage_size) in\n  let offset : PseudoImm.pseudo_imm = range.Location.storage_start in\n  let ce = append_instruction ce (PUSH32 offset) in\n  let ce = append_instruction ce SLOAD in\n  (le, ce)\n\nlet copy_stack_to_stack_top le ce (s : int) =\n  let original_stack_size = stack_size ce in\n  let diff = original_stack_size - s in\n  let () = assert (diff >= 0) in\n  let ce = append_instruction ce (Evm.dup_suc_n diff) in\n  let () = assert (stack_size ce = original_stack_size + 1) in\n  le, ce\n\nlet append_label ce label =\n  append_instruction ce (PUSH4 (DestLabel label))\n\nlet shift_stack_top_to_right ce bits =\n  let () = assert (bits >= 0) in\n  let () = assert (bits < 256) in\n  if bits = 0 then ce\n  else\n    (* [x] *)\n    let ce = append_instruction ce (PUSH1 (Int bits)) in\n    (* [x, bits] *)\n    let ce = append_instruction ce (PUSH1 (Int 2)) in\n    (* [x, bits, 2] *)\n    let ce = append_instruction ce EXP in\n    (* [x, 2 ** bits] *)\n    let ce = append_instruction ce SWAP1 in\n    (* [2 ** bits, x] *)\n    let ce = append_instruction ce DIV in\n    (* [x / (2 ** bits)] *)\n    ce\n\nlet shift_stack_top_to_left ce bits =\n  let () = assert (bits >= 0) in\n  let () = assert (bits < 256) in\n  if bits = 0 then ce\n  else\n    (* [x] *)\n    let ce = append_instruction ce (PUSH1 (Int bits)) in\n    (* [x, bits] *)\n    let ce = append_instruction ce (PUSH1 (Int 2)) in\n    (* [x, bits, 2] *)\n    let ce = append_instruction ce EXP in\n    (* [x, 2 ** bits] *)\n    let ce = append_instruction ce MUL in\n    (* [(2 ** bits) * x] *)\n    ce\n\nlet copy_calldata_to_stack_top le ce (range : Location.calldata_range) =\n  let () = assert (range.Location.calldata_size > 0) in\n  let () = assert (range.Location.calldata_size <= 32) in\n  let ce = append_instruction ce (PUSH4 (Int range.Location.calldata_offset)) in\n  let ce = append_instruction ce CALLDATALOAD in\n  let ce = shift_stack_top_to_right ce ((32 - range.Location.calldata_size) * 8) in\n  le, ce\n\ntype alignment = LeftAligned | RightAligned\n\nlet align_boolean ce alignment =\n  let () = assert (alignment = RightAligned) in\n  ce\n\nlet align_address ce alignment =\n  match alignment with RightAligned -> ce\n                     | LeftAligned ->\n                        shift_stack_top_to_left ce (12 * 8)\n\n\nlet align_from_right_aligned (ce : CodegenEnv.t) alignment typ =\n  match alignment with\n  | RightAligned -> ce\n  | LeftAligned ->\n     let size = size_of_typ typ in\n     let () = assert (size <= 32) in\n     if size = 32 then\n       ce\n     else\n       let shift = (32 - size) * 8 in\n       let ce = append_instruction ce (PUSH1 (Int shift)) in\n       (* stack: [shift] *)\n       let ce = append_instruction ce (PUSH1 (Int 2)) in\n       (* stack: [shift, 2] *)\n       let ce = append_instruction ce EXP in\n       (* stack: [2 ** shift] *)\n       let ce = append_instruction ce MUL in\n       ce\n\n\nlet copy_to_stack_top le ce alignment typ (l : Location.location) =\n  let le, ce =\n    Location.(\n      match l with\n      | Storage range ->\n         copy_storage_range_to_stack_top le ce range\n      | CachedStorage _ -> failwith \"copy_to_stack_top: CachedStorage\"\n      | Volatile _ -> failwith \"copy_to_stack_top: Volatile\"\n      | Code _ -> failwith \"copy_to_stack_top: Code\"\n      | Calldata range -> copy_calldata_to_stack_top le ce range\n      | Stack s ->\n         copy_stack_to_stack_top le ce s\n    ) in\n  let ce = align_from_right_aligned ce alignment typ in\n  (* le needs to remember the alignment *)\n  le, ce\n\nlet swap_entrance_pc_with_zero ce =\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  let ce = append_instruction ce SLOAD in\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  let ce = append_instruction ce DUP1 in\n  let ce = append_instruction ce SSTORE in\n  ce\n\n(** [restore_entrance_pc] moves the topmost stack element to the entrance pc *)\nlet restore_entrance_pc ce =\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  let ce = append_instruction ce SSTORE in\n  ce\n\n(** [throw_if_zero] peeks the topmost stack element and throws if it's zero *)\nlet throw_if_zero ce =\n  let ce = append_instruction ce DUP1 in\n  let ce = append_instruction ce ISZERO in\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  let ce = append_instruction ce JUMPI in\n  ce\n\n(** [push_allocated_memory] behaves like an instruction\n * that takes a desired memory size as an argument.\n * This pushes the allocated address.\n *)\nlet push_allocated_memory (ce : CodegenEnv.t) =\n  let original_stack_size = stack_size ce in\n  (* [desired_length] *)\n  let ce = append_instruction ce (PUSH1 (Int 64)) in\n  let ce = append_instruction ce DUP1 in\n  (* [desired_length, 64, 64] *)\n  let ce = append_instruction ce MLOAD in\n  (* [desired_length, 64, memory[64]] *)\n  let ce = append_instruction ce DUP1 in\n  (* [desired_length, 64, memory[64], memory[64]] *)\n  let ce = append_instruction ce SWAP3 in\n  (* [memory[64], 64, memory[64], desired_length] *)\n  let ce = append_instruction ce ADD in\n  (* [memory[64], 64, new_head] *)\n  let ce = append_instruction ce SWAP1 in\n  (* [memory[64], new_head, 64] *)\n  let ce = append_instruction ce MSTORE in\n  (* [memory[64]] *)\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n\nlet peek_next_memory_allocation (ce : CodegenEnv.t) =\n  let original_stack_size = stack_size ce in\n  (* [] *)\n  let ce = append_instruction ce (PUSH1 (Int 64)) in\n  let ce = append_instruction ce MLOAD in\n  let () = assert (stack_size ce = 1 + original_stack_size) in\n  ce\n\n(** [Tight] just uses [size_of_typ] bytes on the memory.\n *  [ABI] always uses multiples of 32 bytes.\n *  These choices do not affect the alighments\n *)\ntype memoryPacking = TightPacking | ABIPacking\n\nlet copy_from_code_to_memory ce =\n  (* stack: [codesize, codeoffset] *)\n  let ce = append_instruction ce DUP2 in\n  (* stack: [codesize, codeoffset, codesize] *)\n  let ce = push_allocated_memory ce in\n  (* stack: [codesize, codeoffset, memory_address] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: [codesize, memory_address, codeoffset] *)\n  let ce = append_instruction ce DUP3 in\n  (* stack: [codesize, memory_address, codeoffset, codesize] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: [codesize, memory_address, codesize, codeoffset] *)\n  let ce = append_instruction ce DUP3 in\n  (* stack: [codesize, memory_address, codesize, codeoffset, memory_address] *)\n  let ce = append_instruction ce CODECOPY in\n  (* stack: [codesize, memory_address] *)\n  ce\n\n(** [copy_whole_current_code_to_memory] allocates enough memory to accomodate the\n *  whole of the currently running code, and copies it there.\n *  After this, [size, offset] of the memory region is left on the stack.\n *)\nlet copy_whole_current_code_to_memory ce =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce CODESIZE in\n  (* stack: [size] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [size, size] *)\n  let ce = push_allocated_memory ce in\n  (* stack: [size, offset] *)\n  let ce = append_instruction ce DUP2 in\n  (* stack: [size, offset, codesize] *)\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  (* stack: [size, offset, codesize, 0] *)\n  let ce = append_instruction ce DUP3 in\n  (* stack: [size, offset, codesize, 0, offset] *)\n  let ce = append_instruction ce CODECOPY in\n  (* stack: [size, offset] *)\n  let () = assert(original_stack_size + 2 = stack_size ce) in\n  ce\n\nlet push_signature_code (ce : CodegenEnv.t)\n                        (case_signature : usual_case_header)\n  =\n  let hash = Ethereum.case_header_signature_hash case_signature in\n  let ce = append_instruction ce (PUSH4 (Big (WrapBn.hex_to_big_int hash))) in\n  ce\n\n(** [prepare_functiohn_signature ce usual_header]\n *  Allocates 4 bytes on the memory, and puts the function signature of the argument there.\n *  After that, the stack has (..., signature size, signature offset )\n *)\nlet prepare_function_signature ce usual_header =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH1 (Int 4)) in\n  (* stack : (..., 4) *)\n  let ce = append_instruction ce DUP1 in\n  (* stack : (..., 4, 4) *)\n  let ce = push_allocated_memory ce in\n  (* stack : (..., 4, signature_offset) *)\n  let ce = push_signature_code ce usual_header in\n  (* stack : (..., 4, signature_offset, sig) *)\n  let ce = append_instruction ce DUP2 in\n  (* stack : (..., 4, signature_offset, sig, signature_offset) *)\n  let ce = append_instruction ce MSTORE in\n  (* stack : (..., 4, signature_offset) *)\n  let () = assert (stack_size ce = original_stack_size + 2) in\n  ce\n\nlet keccak_cons le ce =\n  let original_stack_size = stack_size ce in\n  (* put the top into 0x00 *)\n  let ce = append_instruction ce (PUSH1 (Int 0x0)) in\n  let ce = append_instruction ce MSTORE in\n  (* put the top into 0x20 *)\n  let ce = append_instruction ce (PUSH1 (Int 0x20)) in\n  let ce = append_instruction ce MSTORE in\n  (* take the sah3 of 0x00--0x40 *)\n  let ce = append_instruction ce (PUSH1 (Int 0x40)) in\n  let ce = append_instruction ce (PUSH1 (Int 0x0)) in\n  let ce = append_instruction ce SHA3 in\n  let () = assert (stack_size ce + 1 = original_stack_size) in\n  ce\n\nlet increase_top ce (inc : int) =\n  let ce = append_instruction ce (PUSH32 (Int inc)) in\n  let ce = append_instruction ce ADD in\n  ce\n\n(** [add_constructor_argument_to_memory ce arg] realizes [arg] on the memory\n *  according to the ABI.  This increases the stack top element by the size of the\n *  new allocation. *)\nlet rec add_constructor_argument_to_memory le (packing : memoryPacking) ce (arg : Syntax.typ exp) =\n  let original_stack_size = stack_size ce in\n  let typ = snd arg in\n  let () = assert (Syntax.fits_in_one_storage_slot typ) in\n  (* stack : [acc] *)\n  let ce = append_instruction ce (PUSH1 (Int\n                                           (match packing with\n                                           | ABIPacking -> 32\n                                           | TightPacking -> Syntax.size_of_typ typ))) in\n  (* stack : [acc, size] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack : [acc, size, size] *)\n  let ce = push_allocated_memory ce in\n  (* stack : [acc, size, offset] *)\n  let ce = codegen_exp le ce (match packing with\n                                  | ABIPacking -> RightAligned\n                                  | TightPacking -> LeftAligned\n                                 ) arg in\n  (* stack : [acc, size, offset, val] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack : [acc, size, val, offset] *)\n  let ce = append_instruction ce MSTORE in\n  (* stack : [acc, size] *)\n  let ce = append_instruction ce ADD in\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n(** [add_constructor_arguments_to_memory args] realizes [args] on the memory\n *  according to the ABI.  This leaves the amount of memory on the stack.\n *  Usually this function is called right after the constructor code is set up in the memory,\n *  so the offset of the memory is not returned.\n *  (This makes it easy for the zero-argument case)\n *)\nand add_constructor_arguments_to_memory le (packing : memoryPacking) ce (args : Syntax.typ exp list) =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  (* stack [0] *)\n  let ce = List.fold_left (add_constructor_argument_to_memory le packing)\n                          ce args in\n  let () = assert (original_stack_size + 1 = stack_size ce) in\n  ce\nand produce_init_code_in_memory (le : LocationEnv.t) ce new_exp =\n  let name = new_exp.new_head in\n  let contract_id =\n    try CodegenEnv.cid_lookup ce name\n    with Not_found ->\n      let () = Printf.eprintf \"A contract of name %s is unknown.\\n%!\" name in\n      raise Not_found\n  in\n  let ce = append_instruction ce (PUSH32 (ConstructorCodeSize contract_id)) in\n  let ce = append_instruction ce (PUSH32 (ConstructorInRuntimeCodeOffset contract_id)) in\n  (* stack: [codesize, codeoffset] *)\n  let ce = copy_from_code_to_memory ce in\n  (* stack: [memory_size, memory_offset] *)\n  let ce = copy_whole_current_code_to_memory ce in\n  (* stack: [memory_size, memory_offset, memory_second_size, memory_second_offset] *)\n\n  (* I still need to add the constructor arguments *)\n  let ce = add_constructor_arguments_to_memory le ABIPacking ce new_exp.new_args in\n  (* stack: [memory_size, memory_offset, memory_second_size, memory_second_offset, memory_args_size] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: [memory_size, memory_offset, memory_second_size, memory_args_size, memory_second_offset] *)\n  let ce = append_instruction ce POP in\n  (* stack: [memory_size, memory_offset, memory_second_size, memory_args_size] *)\n  let ce = append_instruction ce ADD in\n  (* stack: [memory_size, memory_offset, memory_second_args_size] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: [memory_size, memory_second_args_size, memory_offset] *)\n  let ce = append_instruction ce SWAP2 in\n  (* stack: [memory_offset, memory_second_args_size, memory_size] *)\n  let ce = append_instruction ce ADD in\n  (* stack: [memory_offset, memory_total_size] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: [memory_total_size, memory_offset] *)\n  ce\nand codegen_function_call_exp (le : LocationEnv.t) ce alignment (function_call : Syntax.typ Syntax.function_call) (rettyp : Syntax.typ) =\n  if function_call.call_head = \"pre_ecdsarecover\" then\n    let () = assert (alignment = RightAligned) in\n    codegen_ecdsarecover le ce function_call.call_args rettyp (* XXX: need to pass alignment *)\n  else if function_call.call_head = \"keccak256\" then\n    let () = assert (alignment = RightAligned) in\n    codegen_keccak256 le ce function_call.call_args rettyp (* XXX: need to pass alignment *)\n  else if function_call.call_head = \"iszero\" then\n    codegen_iszero le ce alignment function_call.call_args rettyp\n  else\n    failwith \"codegen_function_call_exp: unknown function head.\"\nand codegen_iszero le ce alignment args rettype =\n  match args with\n  | [arg] ->\n     let () = assert (rettype = BoolType) in\n     let ce = codegen_exp le ce alignment arg in\n     let ce = append_instruction ce ISZERO in\n     ce\n  | _ ->\n     failwith \"codegen_iszero: seeing a wrong number of arguments\"\nand codegen_keccak256 le ce args rettyp =\n  let original_stack_size = stack_size ce in\n  let ce = peek_next_memory_allocation ce in\n  (* stack: [..., offset] *)\n  let ce = add_constructor_arguments_to_memory le TightPacking ce args in\n  (* stack: [..., offset, size] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: [..., size, offset] *)\n  let ce = append_instruction ce SHA3 in\n  let () = assert(stack_size ce = original_stack_size + 1) in\n  ce\nand codegen_ecdsarecover le ce args rettyp =\n  match args with\n  | [h; v; r; s] ->\n     (* stack: [] *)\n     let original_stack_size = stack_size ce in\n     let ce = append_instruction ce (PUSH1 (Int 32)) in\n     (* stack: [out size] *)\n     let ce = append_instruction ce DUP1 in\n     (* stack: [out size, out size] *)\n     let ce = push_allocated_memory ce in\n     (* stack: [out size, out address] *)\n     let ce = append_instruction ce DUP2 in\n     (* stack: [out size, out address, out size] *)\n     let ce = append_instruction ce DUP2 in\n     (* stack: [out size, out address, out size, out address] *)\n     let ce = peek_next_memory_allocation ce in\n     let ce = add_constructor_arguments_to_memory le ABIPacking ce args in\n     (* stack: [out size, out address, out size, out address, memory_offset, memory_total_size] *)\n     let ce = append_instruction ce SWAP1 in\n     (* stack: [out size, out address, out size, out address, in size, in offset] *)\n     let ce = append_instruction ce (PUSH1 (Int 0)) in\n     (* stack: [out size, out address, out size, out address, in size, in offset, value] *)\n     let () = assert (stack_size ce = original_stack_size + 7) in\n     let ce = append_instruction ce (PUSH1 (Int 1)) in\n     (* stack: [out size, out address, out size, out address, in size, in offset, value, to] *)\n     let ce = append_instruction ce (PUSH4 (Int 10000)) in\n     (* stack: [out size, out address, out size, out offset, in size, in offset, value, to, gas] *)\n     let ce = append_instruction ce CALL in\n     let () = assert (stack_size ce = original_stack_size + 3) in\n     (* stack: [out size, out address, success?] *)\n     let ce = throw_if_zero ce in\n     let ce = append_instruction ce POP in\n     (* stack: [out size, out address] *)\n     let () = assert (stack_size ce = original_stack_size + 2) in\n     let ce = append_instruction ce SWAP1 in\n     (* stack: [out address, out size] *)\n     let ce = append_instruction ce POP in (* we know it's 32 *)\n     (* stack: [out address] *)\n     let ce = append_instruction ce MLOAD in\n     let () = assert (stack_size ce = original_stack_size + 1) in\n     (* stack: [output] *)\n     ce\n  | _ -> failwith \"pre_ecdsarecover has a wrong number of arguments\"\nand codegen_new_exp (le : LocationEnv.t) ce (new_exp : Syntax.typ Syntax.new_exp) (contractname : string) =\n  let original_stack_size = stack_size ce in\n  (* assert that the reentrance info is throw *)\n  let () = assert(is_throw_only new_exp.new_msg_info.message_reentrance_info)  in\n  (* set up the reentrance guard *)\n  let ce = swap_entrance_pc_with_zero ce in\n  (* stack : [entrance_pc_bkp] *)\n  let ce = produce_init_code_in_memory le ce new_exp in\n  (* stack : [entrance_pc_bkp, size, offset] *)\n  let ce =\n    (match new_exp.new_msg_info.message_value_info with\n     | None -> append_instruction ce (PUSH1 (Int 0)) (* no value info means value of zero *)\n     | Some e -> codegen_exp le ce RightAligned e) in\n  (* stack : [entrance_pc_bkp, size, offset, value] *)\n  let ce = append_instruction ce CREATE in\n  (* stack : [entrance_pc_bkp, create_result] *)\n  (* check the return value, if zero, throw *)\n  let ce = throw_if_zero ce in\n  (* stack : [entrance_pc_bkp, create_result] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack : [create_result, entrance_pc_bkp] *)\n  (* remove the reentrance guard *)\n  let ce = restore_entrance_pc ce in\n  (* stack : [create_result] *)\n  let () = assert (stack_size ce = original_stack_size + 1) in\n  ce\n\nand generate_array_access_index le ce aa =\n  let array = aa.array_access_array in\n  let index = aa.array_access_index in\n  let ce = codegen_exp le ce RightAligned index in\n  let ce = codegen_exp le ce RightAligned array in\n  let ce = keccak_cons le ce in\n  ce\n\nand codegen_array_access (le : LocationEnv.t) ce (aa : Syntax.typ Syntax.array_access) =\n  let ce = generate_array_access_index le ce aa in\n  let ce = append_instruction ce SLOAD in\n  ce\n\n(* if the stack top is zero, set up an array seed at aa, and replace the zero with the new seed *)\nand setup_array_seed_at_array_access le ce aa =\n  let shortcut_label = Label.new_label () in\n  (* stack: [result, result] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [result, result] *)\n  let ce = append_label ce shortcut_label in\n  (* stack: [result, result, shortcut] *)\n  let ce = append_instruction ce JUMPI in\n  (* stack: [result] *)\n  let ce = append_instruction ce POP in\n  (* stack: [] *)\n  let ce = generate_array_access_index le ce aa in\n  (* stack: [storage_index] *)\n  let ce = append_instruction ce (PUSH1 (Int 1)) in\n  (* stack: [storage_index, 1] *)\n  let ce = append_instruction ce SLOAD in\n  (* stack: [storage_index, orig_seed] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [storage_index, orig_seed, orig_seed] *)\n  let ce = increase_top ce 1 in\n  (* stack: [storage_index, orig_seed, orig_seed + 1] *)\n  let ce = append_instruction ce (PUSH1 (PseudoImm.Int 1)) in\n  (* stack: [storage_index, orig_seed, orig_seed + 1, 1] *)\n  let ce = append_instruction ce SSTORE in\n  (* stack: [storage_index, orig_seed] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [storage_index, orig_seed, orig_seed] *)\n  let ce = append_instruction ce SWAP2 in\n  (* stack: [orig_seed, orig_seed, storage_index] *)\n  let ce = append_instruction ce SSTORE in\n  (* stack: [orig_seed] *)\n  let ce = append_instruction ce (JUMPDEST shortcut_label) in\n  (* stack: [result] *)\n  ce\n\n(* if the stack top is zero, set up an array seed at aa, and replace the zero with the new seed *)\nand setup_array_seed_at_location le ce loc =\n  let storage_idx =\n    match loc with\n    | Location.Storage str_range ->\n       let () = assert (str_range.Location.storage_size = (Int 1)) in\n       str_range.Location.storage_start\n    | _ -> failwith \"setup array seed at non-storage\" in\n  let shortcut_label = Label.new_label () in\n  (* stack: [result, result] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [result, result] *)\n  let ce = append_instruction ce (PUSH32 (DestLabel shortcut_label)) in\n  (* stack: [result, result, shortcut] *)\n  let ce = append_instruction ce JUMPI in\n  (* stack: [result] *)\n  let ce = append_instruction ce POP in\n  (* stack: [] *)\n  let ce = append_instruction ce (PUSH32 storage_idx) in\n  (* stack: [storage_index] *)\n  let ce = append_instruction ce (PUSH1 (Int 1)) in\n  (* stack: [storage_index, 1] *)\n  let ce = append_instruction ce SLOAD in\n  (* stack: [storage_index, orig_seed] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [storage_index, orig_seed, orig_seed] *)\n  let ce = increase_top ce 1 in\n  (* stack: [storage_index, orig_seed, orig_seed + 1] *)\n  let ce = append_instruction ce (PUSH1 (PseudoImm.Int 1)) in\n  (* stack: [storage_index, orig_seed, orig_seed + 1, 1] *)\n  let ce = append_instruction ce SSTORE in\n  (* stack: [storage_index, orig_seed] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [storage_index, orig_seed, orig_seed] *)\n  let ce = append_instruction ce SWAP2 in\n  (* stack: [orig_seed, orig_seed, storage_index] *)\n  let ce = append_instruction ce SSTORE in\n  (* stack: [orig_seed] *)\n  let ce = append_instruction ce (JUMPDEST shortcut_label) in\n  (* stack: [result] *)\n  ce\n\n(* le is not updated here.  It can be only updated in\n * a variable initialization *)\nand codegen_exp\n      (le : LocationEnv.t)\n      (ce : CodegenEnv.t)\n      (alignment : alignment)\n      ((e,t) : Syntax.typ Syntax.exp) :\n      CodegenEnv.t =\n  let ret =\n  (match e,t with\n   | AddressExp ((c, ContractInstanceType _)as inner), AddressType ->\n      let ce = codegen_exp le ce alignment inner in\n      (* c is a contract instance.\n       * The concrete representation of a contact instance is\n       * already the address\n       *)\n      ce\n   | AddressExp _, _ ->\n      failwith \"codegen_exp: AddressExp of unexpected type\"\n   | ValueExp,Uint256Type ->\n      let ce = CodegenEnv.append_instruction ce CALLVALUE in\n      ce\n   | ValueExp,_ -> failwith \"ValueExp of strange type\"\n   | SenderExp,AddressType ->\n      let ce = CodegenEnv.append_instruction ce CALLER in\n      let ce = align_address ce alignment in\n      ce\n   | SenderExp,_ -> failwith \"codegen_exp: SenderExp of strange type\"\n   | ArrayAccessExp aa, typ ->\n      let ce = codegen_array_access le ce (read_array_access aa) in\n      let () = assert (alignment = RightAligned) in\n      begin match typ with\n      | MappingType _ ->\n         setup_array_seed_at_array_access le ce (read_array_access aa)\n      | _ -> ce\n      end\n   | ThisExp,_ ->\n      let ce = CodegenEnv.append_instruction ce ADDRESS in\n      let ce = align_address ce alignment in\n      ce\n   | IdentifierExp id, typ ->\n      begin match LocationEnv.lookup le id with\n      (** if things are just DUP'ed, location env should not be\n       * updated.  If they are SLOADED, the location env should be\n       * updated. *)\n      | Some location ->\n         let (le, ce) = copy_to_stack_top le ce alignment typ location in\n         begin match typ with\n         | MappingType _ ->\n            setup_array_seed_at_location le ce location\n         | _ -> ce\n         end\n      | None ->\n         failwith (\"codegen_exp: identifier's location not found: \"^id)\n      end\n  | FalseExp,BoolType ->\n     let ce = CodegenEnv.append_instruction\n                ce (Evm.PUSH1 (Big WrapBn.zero_big_int)) in\n     let () = assert (alignment = RightAligned) in\n     ce\n  | FalseExp, _ -> failwith \"codegen_exp: FalseExp of unexpected type\"\n  | TrueExp,BoolType ->\n     let ce = append_instruction ce (PUSH1 (Big WrapBn.unit_big_int)) in\n     let () = assert (alignment = RightAligned) in\n     ce\n  | TrueExp, _ -> failwith \"codegen_exp: TrueExp of unexpected type\"\n  | DecLit256Exp d, Uint256Type ->\n     let ce = append_instruction ce (PUSH32 (Big d)) in\n     let () = assert (alignment = RightAligned) in\n     ce\n  | DecLit256Exp d, _ ->\n      failwith (\"codegen_exp: DecLit256Exp of unexpected type: \"^(WrapBn.string_of_big_int d))\n  | DecLit8Exp d, Uint8Type ->\n     let ce = append_instruction ce (PUSH1 (Big d)) in\n     let () = assert (alignment = RightAligned) in\n     ce\n  | DecLit8Exp d, _ ->\n      failwith (\"codegen_exp: DecLit8Exp of unexpected type: \"^(WrapBn.string_of_big_int d))\n  | LandExp (l, r), BoolType ->\n     let shortcut_label = Label.new_label () in\n     let () = assert (alignment = RightAligned) in\n     let ce = codegen_exp le ce RightAligned l in\n     (* stack: [..., l] *)\n     let ce = append_instruction ce DUP1 in\n     (* stack: [..., l, l] *)\n     let ce = append_instruction ce ISZERO in\n     (* stack: [..., l, !l] *)\n     let ce = append_label ce shortcut_label in\n     (* stack: [..., l, !l, shortcut] *)\n     let ce = append_instruction ce JUMPI in\n     (* stack: [..., l] *)\n     let ce = append_instruction ce POP in\n     (* stack: [...] *)\n     let ce = codegen_exp le ce RightAligned r in\n     (* stack: [..., r] *)\n     let ce = append_instruction ce (JUMPDEST shortcut_label) in\n     let ce = append_instruction ce ISZERO in\n     let ce = append_instruction ce ISZERO in\n     ce\n  | LandExp (_, _), _ ->\n     failwith \"codegen_exp: LandExp of unexpected type\"\n  | NotExp sub, BoolType ->\n     let ce = codegen_exp le ce alignment sub in\n     let ce = append_instruction ce ISZERO in\n     let ce = align_boolean ce alignment in\n     ce\n  | NotExp sub, _ ->\n     failwith \"codegen_exp: NotExp of unexpected type\"\n  | NowExp,Uint256Type ->\n     append_instruction ce TIMESTAMP\n  | NowExp,_ -> failwith \"codegen_exp: NowExp of unexpected type\"\n  | NeqExp (l, r), BoolType ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in (* l later because it should come at the top *)\n     let ce = append_instruction ce EQ in\n     let ce = append_instruction ce ISZERO in\n     let ce = align_boolean ce alignment in\n     ce\n  | NeqExp _, _ ->\n     failwith \"codegen_exp: NeqExp of unexpected type\"\n  | LtExp (l, r), BoolType ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce LT in\n     let ce = align_boolean ce alignment in\n     ce\n  | LtExp _, _ -> failwith \"codegen_exp: LtExp of unexpected type\"\n  | PlusExp (l, r), Uint256Type ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce ADD in\n     ce\n  | PlusExp (l, r), Uint8Type ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce ADD in\n     ce\n  | PlusExp (l, r), _ ->\n     failwith \"codegen_exp PlusExp of unexpected type\"\n  | MinusExp (l, r), Uint256Type ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce SUB in\n     ce\n  | MinusExp (l, r), Uint8Type ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce SUB in\n     ce\n  | MinusExp (l, r), _ ->\n     failwith \"codegen_exp MinusExp of unexpected type\"\n  | MultExp (l, r), Uint256Type ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce MUL in\n     ce\n  | MultExp (l, r), Uint8Type ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce MUL in\n     ce\n  | MultExp (l, r), _ ->\n     failwith \"codegen_exp: MultExp of unexpected type\"\n  | GtExp (l, r), BoolType ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce GT in\n     let ce = align_boolean ce alignment in (* XXX there should be some type system making sure this line exists *)\n     ce\n  | GtExp _, _ -> failwith \"codegen_exp GtExp of unexpected type\"\n  | BalanceExp inner, Uint256Type ->\n     let ce = codegen_exp le ce RightAligned inner in\n     let ce = append_instruction ce BALANCE in\n     ce\n  | BalanceExp inner, _ ->\n     failwith \"codegen_exp: BalanceExp of unexpected type\"\n  | EqualityExp (l, r), BoolType ->\n     let ce = codegen_exp le ce RightAligned r in\n     let ce = codegen_exp le ce RightAligned l in\n     let ce = append_instruction ce EQ in\n     let ce = align_boolean ce alignment in\n     ce\n  | EqualityExp _, _ ->\n     failwith \"codegen_exp EqualityExp of unexpected type\"\n  | SendExp s, _ ->\n     let () = assert (alignment = RightAligned) in\n     codegen_send_exp le ce s\n  | NewExp new_e, ContractInstanceType ctyp ->\n     let () = assert (alignment = RightAligned) in\n     codegen_new_exp le ce new_e ctyp\n  | NewExp new_e, _ ->\n     failwith \"exp code gen for new expression with unexpected type\"\n  | FunctionCallExp function_call, rettyp ->\n     codegen_function_call_exp le ce alignment function_call rettyp\n  | ParenthExp _, _ ->\n     failwith \"ParenthExp not expected.\"\n  | SingleDereferenceExp (reference, ref_typ), value_typ ->\n     let () = assert (ref_typ = ReferenceType [value_typ]) in\n     let size = Syntax.size_of_typ value_typ in\n     let () = assert (size <= 32) in (* assuming word-size *)\n     let ce = codegen_exp le ce RightAligned (reference, ref_typ) in (* pushes the pointer *)\n     let ce = append_instruction ce MLOAD in\n     let () = assert (alignment = RightAligned) in\n     ce\n  | TupleDereferenceExp _, _ ->\n     failwith \"code generation for TupleDereferenceExp should not happen.  Instead, try to decompose it into several assignments.\"\n  ) in\n  let () = assert (stack_size ret = stack_size ce + 1) in\n  ret\n(** [prepare_argument ce arg] places an argument in the memory, and increments the stack top position by the size of the argument. *)\nand prepare_argument le ce arg =\n  (* stack: (..., accum) *)\n  let original_stack_size = stack_size ce in\n  let size = Syntax.size_of_typ (snd arg) in\n  let () = assert (size = 32) in\n  let ce = append_instruction ce (PUSH1 (Int size)) in\n  (* stack: (..., accum, size) *)\n  let ce = codegen_exp le ce RightAligned arg in\n  (* stack: (..., accum, size, val) *)\n  let ce = append_instruction ce DUP2 in\n  (* stack: (..., accum, size, val, size) *)\n  let ce = push_allocated_memory ce in\n  (* stack: (..., accum, size, val, offset) *)\n  let ce = append_instruction ce MSTORE in\n  (* stack: (..., accum, size) *)\n  let ce = append_instruction ce ADD in\n  (* stack: (..., new_accum) *)\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n(** [prepare_arguments] prepares arguments in the memory.\n *  This leaves (..., args size) on the stack.\n *  Since this is called always immediately after allocating memory for the signature,\n *  the offset of the memory is not necessary.\n *  Also, when there are zero amount of memory desired, it's easy to just return zero.\n *)\nand prepare_arguments le ce args =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  let ce = List.fold_left\n             (prepare_argument le) ce args in\n  let () = assert (stack_size ce = original_stack_size + 1) in\n  ce\n(** [prepare_input_in_memory] prepares the input for CALL instruction in the memory.\n *  That leaves \"..., in size, in offset\" (top) on the stack.\n *)\nand prepare_input_in_memory le ce s usual_header : CodegenEnv.t =\n  let original_stack_size = stack_size ce in\n  let ce = prepare_function_signature ce usual_header in\n  (* stack : [signature size, signature offset] *)\n  let args = s.send_args in\n  let ce = prepare_arguments le ce args in (* this should leave only one number on the stack!! *)\n  (* stack : [signature size, signature offset, args size] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack : [signature size, args size, signature offset] *)\n  let ce = append_instruction ce SWAP2 in\n  (* stack : [signature offset, args size, signature size] *)\n  let ce = append_instruction ce ADD in\n  (* stack : [signature offset, total size] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack : [total size, signature offset] *)\n  let () = assert (stack_size ce = original_stack_size + 2) in\n  ce\n(** [obtain_return_values_from_memory] assumes stack (..., out size, out offset),\n    and copies the outputs onto the stack.  The first comes top-most. *)\n(* XXX currently supports one-word output only *)\nand obtain_return_values_from_memory ce =\n  (* stack: out size, out offset *)\n  let ce = append_instruction ce DUP2 in\n  (* stack: out size, out offset, out size *)\n  let ce = append_instruction ce (PUSH1 (Int 32)) in\n  (* stack: out size, out offset, out size, 32 *)\n  let ce = append_instruction ce EQ in\n  (* stack: out size, out offset, out size = 32 *)\n  let ce = append_instruction ce ISZERO in\n  (* stack: out size, out offset, out size != 32 *)\n  let ce = append_instruction ce (PUSH1 (Int 0)) in\n  (* stack: out size, out offset, out size != 32, 0 *)\n  let ce = append_instruction ce JUMPI in\n  (* stack: out size, out offset *)\n  let ce = append_instruction ce MLOAD in\n  (* stack: out size, out *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack: out, out size *)\n  let ce = append_instruction ce POP in\n  (* stack: out *)\n  ce\nand codegen_send_exp le ce (s : Syntax.typ Syntax.send_exp) =\n  let original_stack_size = stack_size ce in\n  let head_contract = s.send_head_contract in\n  match snd head_contract with\n  | ContractInstanceType contract_name ->\n     let callee_contract_id =\n       try CodegenEnv.cid_lookup ce contract_name\n       with Not_found ->\n         let () = Printf.eprintf \"A contract of name %s is unknown.\\n%!\" contract_name in\n         raise Not_found\n     in\n     let callee_contract : Syntax.typ Syntax.contract =\n       CodegenEnv.contract_lookup ce callee_contract_id in\n     let contract_lookup_by_name (name : string) : Syntax.typ Syntax.contract =\n       let contract_id =\n         begin try\n           CodegenEnv.cid_lookup ce name\n         with Not_found ->\n           let () = Printf.eprintf \"A contract of name %s is unknown.\\n%!\" contract_name in\n           raise Not_found\n         end\n       in\n       CodegenEnv.contract_lookup ce contract_id in\n     begin match s.send_head_method with\n     | None -> failwith \"could not find the method name\"\n     | Some method_name ->\n        let usual_header : usual_case_header =\n          Syntax.lookup_usual_case_header callee_contract method_name contract_lookup_by_name in\n        let () = assert(is_throw_only s.send_msg_info.message_reentrance_info)  in\n        let ce = swap_entrance_pc_with_zero ce in\n        (* stack : [entrance_pc_bkp] *)\n        let return_typ = usual_header.case_return_typ in\n        let return_size = Syntax.size_of_typs return_typ in\n        (* stack : [entrance_bkp] *)\n        let ce = append_instruction ce (PUSH1 (Int return_size)) in\n        (* stack : [entrance_bkp, out size] *)\n        let ce = append_instruction ce DUP1 in\n        (* stack : [entrance_bkp, out size, out size] *)\n        let () = assert (stack_size ce = original_stack_size + 3) in\n        let ce = push_allocated_memory ce in\n        (* stack : [entrance_bkp, out size, out offset] *)\n        let ce = append_instruction ce DUP2 in\n        (* stack : [entrance_bkp, out size, out offset, out size] *)\n        let ce = append_instruction ce DUP2 in\n        (* stack : [entrance_bkp, out size, out offset, out size, out offset] *)\n        let ce = prepare_input_in_memory le ce s usual_header in\n        (* stack : [entrance_bkp, out size, out offset, out size, out offset, in size, in offset] *)\n        let ce =\n          (match s.send_msg_info.message_value_info with\n           | None -> append_instruction ce (PUSH1 (Int 0)) (* no value info means value of zero *)\n           | Some e ->\n              codegen_exp le ce RightAligned e) in\n        (* stack : [entrance_bkp, out size, out offset, out size, out offset, in size, in offset, value] *)\n        let ce = codegen_exp le ce RightAligned s.send_head_contract in\n        let ce = append_instruction ce (PUSH4 (Int 3000)) in\n        let ce = append_instruction ce GAS in\n        let ce = append_instruction ce SUB in\n        (* stack : [entrance_bkp, out size, out offset, out size, out offset, in size, in offset, value, to, gas] *)\n        let ce = append_instruction ce CALL in\n        (* stack : [entrance_bkp, out size, out offset, success] *)\n        let () = assert (stack_size ce = original_stack_size + 4) in\n        let ce = append_instruction ce ISZERO in\n        let ce = append_instruction ce (PUSH1 (Int 0)) in\n        let ce = append_instruction ce JUMPI in\n        (* stack : [entrance_bkp, out size, out offset] *)\n        let () = assert (stack_size ce = original_stack_size + 3) in\n        let ce = append_instruction ce SWAP2 in\n        (* stack : [out offset, out size entrance_bkp] *)\n        let ce = restore_entrance_pc ce in\n        (* stack : [out offset, out size] *)\n        let ce = append_instruction ce SWAP1 in\n        (* stack : [out size, out offset] *)\n        let ce = obtain_return_values_from_memory ce in\n        (* stack : [outputs] *)\n        ce\n     end\n  | AddressType ->\n     let () = assert(is_throw_only s.send_msg_info.message_reentrance_info)  in\n     let ce = swap_entrance_pc_with_zero ce in\n     (* stack : [entrance_pc_bkp] *)\n     let return_size = 0 in\n     (* stack : [entrance_bkp] *)\n     let ce = append_instruction ce (PUSH1 (Int return_size)) in\n     (* stack : [entrance_bkp, 0] *)\n     let ce = append_instruction ce DUP1 in\n     (* stack : [entrance_bkp, 0, 0] *)\n     let () = assert (stack_size ce = original_stack_size + 3) in\n     let ce = append_instruction ce DUP2 in\n     (* stack : [entrance_bkp, 0, 0, 0] *)\n     let ce = append_instruction ce DUP2 in\n     (* stack : [entrance_bkp, 0, 0, 0, 0] *)\n     let ce = append_instruction ce DUP2 in\n     (* stack : [entrance_bkp, 0, 0, 0, 0, 0] *)\n     let ce = append_instruction ce DUP2 in\n     (* stack : [entrance_bkp, 0,        0,          0,        0,          0,       0] *)\n     (* stack : [entrance_bkp, out size, out offset, out size, out offset, in size, in offset] *)\n     let ce =\n       (match s.send_msg_info.message_value_info with\n        | None -> append_instruction ce (PUSH1 (Int 0)) (* no value info means value of zero *)\n        | Some e -> codegen_exp le ce RightAligned e) in\n     (* stack : [entrance_bkp, out size, out offset, out size, out offset, in size, in offset, value] *)\n     let ce = codegen_exp le ce RightAligned s.send_head_contract in\n     let ce = append_instruction ce (PUSH4 (Int 3000)) in\n     let ce = append_instruction ce GAS in\n     let ce = append_instruction ce SUB in\n     (* stack : [entrance_bkp, out size, out offset, out size, out offset, in size, in offset, value, to, gas] *)\n     let ce = append_instruction ce CALL in\n     (* stack : [entrance_bkp, out size, out offset, success] *)\n     let () = assert (stack_size ce = original_stack_size + 4) in\n     let ce = append_instruction ce ISZERO in\n     let ce = append_instruction ce (PUSH1 (Int 0)) in\n     let ce = append_instruction ce JUMPI in\n     (* stack : [entrance_bkp, out size, out offset] *)\n     let () = assert (stack_size ce = original_stack_size + 3) in\n     let ce = append_instruction ce SWAP2 in\n     (* stack : [out offset, out size entrance_bkp] *)\n     let ce = restore_entrance_pc ce in\n     (* stack : [0, 0] *)\n     let ce = append_instruction ce POP in (* XXX: Some optimizations possible. *)\n     (* stack : [0] *)\n     ce\n  | VoidType -> failwith \"send expression with VoidType?\"\n  | Uint256Type -> failwith \"send expression with Uint256Type?\"\n  | Uint8Type -> failwith \"send expression with Uint8Type?\"\n  | _ -> failwith \"send expression with unknown type\"\n\n\nlet codegen_sentence\n  (orig : CodegenEnv.t)\n  (s : Syntax.typ Syntax.sentence)\n  (* is this enough? also add sentence Id's around?\n   * I think this is enough.\n   *)\n  : CodegenEnv.t = failwith \"codegen_sentence\"\n\nlet move_info_around\n  (assumption : CodegenEnv.t)\n  (goal : LocationEnv.t) :\n      CodegenEnv.t = failwith \"move_info_around\"\n\nlet codegen_bytecode\n  (src : Syntax.typ Syntax.contract) :\n      PseudoImm.pseudo_imm Evm.program = failwith \"codegen_bytecode\"\n\n(** [initialize_memory_allocator] initializes memory position 64 as 96 *)\nlet initialize_memory_allocator (ce : CodegenEnv.t) =\n  let ce = append_instruction ce (PUSH1 (Int 96)) in\n  let ce = append_instruction ce (PUSH1 (Int 64)) in\n  let ce = append_instruction ce MSTORE in\n  ce\n\n\n(** [copy_arguments_from_code_to_memory]\n *  copies constructor arguments at the end of the\n *  bytecode into the memory.  The number of bytes is\n *  decided using the contract interface.\n *  The memory usage counter at byte [0x40] is increased accordingly.\n *  After this, the stack contains the size and the beginning of the memory\n *  piece that contains the arguments.\n *  Output [rest of the stack, mem_size, mem_begin].\n *)\nlet copy_arguments_from_code_to_memory\n      (le : LocationEnv.t)\n      (ce : CodegenEnv.t)\n      (contract : Syntax.typ Syntax.contract) :\n      (CodegenEnv.t) =\n  let total_size = Ethereum.total_size_of_interface_args\n                     (List.map snd (Ethereum.constructor_arguments contract)) in\n  let original_stack_size = stack_size ce in\n  (* [] *)\n  let ce = append_instruction ce (PUSH32 (Int total_size)) in\n  (* [total_size] *)\n  let ce = append_instruction ce DUP1 in\n  (* [total_size, total_size] *)\n  let ce = push_allocated_memory ce in\n  (* [total_size, memory_start] *)\n  let ce = append_instruction ce DUP2 in\n  (* [total_size, memory_start, total_size] *)\n  let ce = append_instruction ce DUP1 in\n  (* [total_size, memory_start, total_size, total_size] *)\n  let ce = append_instruction ce CODESIZE in\n  (* [total_size, memory_start, total_size, total_size, code size] *)\n  let ce = append_instruction ce SUB in\n  (* [total_size, memory_start, total_size, code_begin] *)\n  let ce = append_instruction ce DUP3 in\n  (* [total size, memory_start, total_size, code_begin, memory_start *)\n  let ce = append_instruction ce CODECOPY in\n  (* [total size, memory_start] *)\n  let () = assert (original_stack_size + 2 = stack_size ce) in\n  ce\n\n(**\n * [set_contract_pc ce id] puts the program counter for the contract specified by\n   [id] in the storage at index [StorageProgramCounterIndex]\n *)\nlet set_contract_pc ce (id : Assoc.contract_id) =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH32 (ContractOffsetInRuntimeCode id)) in\n  let ce = append_instruction ce (PUSH32 StorageProgramCounterIndex) in\n  let ce = append_instruction ce SSTORE in\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n\n(**\n * [get_contract_pc ce] pushes the value at [StorageProgramCounterIndex] in storage.\n *)\nlet get_contract_pc ce =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH32 StorageProgramCounterIndex) in\n  let ce = append_instruction ce SLOAD in\n  let () = assert (stack_size ce = original_stack_size + 1) in\n  ce\n\n(**\n * [bulk_store_from_memory ce]\n * adds instructions to ce after which some memory contents are copied\n * to the storage.\n * Precondition: the stack has [..., size, memory_src_start, storage_target_start]\n * Postcondition: the stack has [...]\n *)\nlet bulk_sstore_from_memory ce =\n  let original_stack_size = stack_size ce in\n  (* TODO: check that size is a multiple of 32 *)\n  let jump_label_continue = Label.new_label () in\n  let jump_label_exit = Label.new_label () in\n  let ce = append_instruction ce (JUMPDEST jump_label_continue) in\n  (* stack [..., size, memory_src_start, storage_target_start] *)\n  let ce = append_instruction ce DUP3 in\n  (* stack [..., size, memory_src_start, storage_target_start, size] *)\n  let ce = append_instruction ce ISZERO in\n  (* stack [..., size, memory_src_start, storage_target_start, size is zero] *)\n  let ce = append_label ce jump_label_exit in\n  (* stack [..., size, memory_src_start, storage_target_start, size is zero, jump_label_exit] *)\n  let () = assert (stack_size ce = original_stack_size + 2) in\n  let ce = append_instruction ce JUMPI in\n  (* stack [..., size, memory_src_start, storage_target_start] *)\n  let ce = append_instruction ce DUP2 in\n  (* stack [..., size, memory_src_start, storage_target_start, memory_src_start] *)\n  let ce = append_instruction ce MLOAD in\n  (* stack [..., size, memory_src_start, storage_target_start, stored] *)\n  let ce = append_instruction ce DUP2 in\n  (* stack [..., size, memory_src_start, storage_target_start, stored, storage_target_start] *)\n  let ce = append_instruction ce SSTORE in\n  (* stack [..., size, memory_src_start, storage_target_start] *)\n  (* decrease size *)\n  let ce = append_instruction ce (PUSH32 (Int 32)) in\n  (* stack [..., size, memory_src_start, storage_target_start, 32] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack [..., size, memory_src_start, 32, storage_target_start] *)\n  let ce = append_instruction ce SWAP3 in\n  (* stack [..., storage_target_start, memory_src_start, 32, size] *)\n  let ce = append_instruction ce SUB in\n  (* stack [..., storage_target_start, memory_src_start, new_size] *)\n  let ce = append_instruction ce SWAP2 in\n  (* stack [..., new_size, memory_src_start, storage_target_start] *)\n  let ce = increase_top ce 1 in (* 1 word is 32 bytes. *)\n  (* stack [..., new_size, memory_src_start, new_storage_target_start] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack [..., new_size, new_storage_target_start, memory_src_start] *)\n  (* increase memory_src_start *)\n  let ce = increase_top ce 32 in\n  (* stack [..., new_size, new_storage_target_start, new_memory_src_start] *)\n  let ce = append_instruction ce SWAP1 in\n  (* stack [..., new_size, new_memory_src_start, new_storage_target_start] *)\n  let () = assert (stack_size ce = original_stack_size) in\n  (** add create a combinatino of jump and reset_stack_size *)\n  let ce = append_label ce jump_label_continue in\n  let ce = append_instruction ce JUMP in\n  (* stack [..., new_size, new_memory_src_start, new_storage_target_start] *)\n  let ce = set_stack_size ce (original_stack_size) in\n  let ce = append_instruction ce (JUMPDEST jump_label_exit) in\n  (* stack [..., size, memory_src_start, storage_target_start] *)\n  let ce = append_instruction ce POP in\n  let ce = append_instruction ce POP in\n  let ce = append_instruction ce POP in\n  let () = assert (stack_size ce = original_stack_size - 3) in\n  (* stack [...] *)\n  ce\n\n(** [copy_arguments_from_memory_to_storage le ce]\n *  adds instructions to ce such that the constructor arguments\n *  stored in the memory are copied to the storage.\n *  Precondition: the stack has [..., total, memory_start]\n *  Final storage has the arguments in [ConstructorArgumentBegin...ConstructorArgumentBegin + ConstructorArgumentLength]\n *  The final stack has [...] in the precondition.\n *)\nlet copy_arguments_from_memory_to_storage le ce (contract_id : Assoc.contract_id) =\n  let ce = append_instruction\n             ce (PUSH32 (InitDataSize contract_id)) in\n  let ce = append_instruction ce CODESIZE in\n  let ce = append_instruction ce EQ in\n  let ce = append_instruction ce ISZERO in\n  let ce = append_instruction ce (PUSH1 (Int 2)) in\n  let ce = append_instruction ce JUMPI in\n  let ce = append_instruction\n             ce (PUSH32 (StorageConstructorArgumentsBegin contract_id)) in\n  (* stack, [..., size, memory_start, destination_storage_start] *)\n  bulk_sstore_from_memory ce\n\n(** [copy_runtime_code_to_memory ce contracts contract_id]\n * adds instructions to [ce] so that in the final\n * state the memory contains the runtime code\n * for all contracts that are reachable from [contract_id] in the\n * list [contracts] in the\n * addresses [code_start, code_start + code_size).\n * This adds two elements to the stack, resulting in\n * [..., code_length, code_start) *)\nlet copy_runtime_code_to_memory ce contracts contract_id =\n  let original_stack_size = stack_size ce in\n  (* stack: [...] *)\n  let ce = append_instruction ce (PUSH32 (RuntimeCodeSize)) in\n  (* stack: [run_code_size] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [run_code_size, run_code_size] *)\n  let ce = push_allocated_memory ce in\n  (* stack: [run_code_size, run_code_address] *)\n  let ce = append_instruction ce DUP2 in\n  (* stack: [run_code_size, run_code_address, run_code_size] *)\n  let ce = append_instruction ce (PUSH32 (RuntimeCodeOffset contract_id)) in\n  (* stack: [run_code_size, run_code_address, run_code_size, RuntimeCodeOffset] *)\n  let ce = append_instruction ce DUP3 in\n  (* stack: [run_code_size, run_code_address, run_code_size, run_code_in_code, run_code_address] *)\n  let ce = append_instruction ce CODECOPY in\n  (* stack: [run_code_size, run_code_address] *)\n  let () = assert (stack_size ce = original_stack_size + 2) in\n  ce\n\nlet cid_lookup_in_assoc (contracts : Syntax.typ Syntax.contract Assoc.contract_id_assoc)\n                        (name : string) : Assoc.contract_id =\n  Assoc.lookup_id (fun c -> c.contract_name = name) contracts\n\nlet setup_seed (le, ce) (loc : Storage.storage_location) =\n  let jump_label_skip = Label.new_label () in\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH4 (PseudoImm.Int loc)) in\n  (* stack: [seed] *)\n  let ce = append_label ce jump_label_skip in\n  let ce = append_instruction ce JUMPI in\n  let ce = append_instruction ce (PUSH1 (PseudoImm.Int 1)) in\n  (* stack: [1] *)\n  let ce = append_instruction ce SLOAD in\n  (* stack: [orig_seed] *)\n  let ce = append_instruction ce DUP1 in\n  (* stack: [orig_seed, orig_seed] *)\n  let ce = append_instruction ce (PUSH4 (PseudoImm.Int loc)) in\n  (* stack: [orig_seed, orig_seed, loc] *)\n  let ce = append_instruction ce SSTORE in\n  (* stack: [orig_seed] *)\n  let ce = increase_top ce 1 in\n  (* stack: [orig_seed + 1] *)\n  let ce = append_instruction ce (PUSH1 (PseudoImm.Int 1)) in\n  (* stack: [orig_seed + 1, 1] *)\n  let ce = append_instruction ce SSTORE in\n  let ce = append_instruction ce (JUMPDEST jump_label_skip) in\n  (* stack: [] *)\n  let () = assert (stack_size ce = original_stack_size) in\n  (le, ce)\n\nlet setup_array_seed_counter_to_one_if_not_initialized ce =\n  let original_stack_size = stack_size ce in\n  let jump_label_skip = Label.new_label () in\n  let ce = append_instruction ce (PUSH1 (Int 1)) in\n  let ce = append_instruction ce SLOAD in\n  let ce = append_label ce jump_label_skip in\n  let ce = append_instruction ce JUMPI in\n  (* the case where it has to be changed *)\n  let ce = append_instruction ce (PUSH1 (Int 1)) in\n  let ce = append_instruction ce DUP1 in\n  let ce = append_instruction ce SSTORE in\n  let ce = append_instruction ce (JUMPDEST jump_label_skip) in\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n\nlet setup_array_seeds le ce (contract: Syntax.typ Syntax.contract) : CodegenEnv.t =\n  let ce = setup_array_seed_counter_to_one_if_not_initialized ce in\n  let array_locations = LayoutInfo.array_locations contract in\n  let (_, ce) =\n    List.fold_left setup_seed (le, ce) array_locations in\n  ce\n\nlet codegen_constructor_bytecode\n      ((contracts : Syntax.typ Syntax.contract Assoc.contract_id_assoc),\n       (contract_id : Assoc.contract_id))\n    :\n      (CodegenEnv.t (* containing the program *)\n       ) =\n  let le = LocationEnv.constructor_initial_env contract_id\n                                               (Assoc.choose_contract contract_id contracts) in\n  let ce = CodegenEnv.empty_env (cid_lookup_in_assoc contracts) contracts in\n  let ce = initialize_memory_allocator ce in\n  (* implement some kind of fold function over the argument list\n   * each step generates new (le,ce) *)\n  let ce = copy_arguments_from_code_to_memory le ce\n             (Assoc.choose_contract contract_id contracts) in\n  (* stack: [arg_mem_size, arg_mem_begin] *)\n  let (ce: CodegenEnv.t) = copy_arguments_from_memory_to_storage le ce contract_id in\n  (* stack: [] *)\n  (* set up array seeds *)\n  let (ce :CodegenEnv.t) = setup_array_seeds le ce (Assoc.choose_contract contract_id contracts) in\n  let ce = set_contract_pc ce contract_id in\n  (* stack: [] *)\n  let ce = copy_runtime_code_to_memory ce contracts contract_id in\n  (* stack: [code_length, code_start_on_memory] *)\n  let ce = CodegenEnv.append_instruction ce RETURN in\n  ce\n\ntype constructor_compiled =\n  { constructor_codegen_env : CodegenEnv.t\n  ; constructor_interface : Contract.contract_interface\n  ; constructor_contract : Syntax.typ Syntax.contract\n  }\n\ntype runtime_compiled =\n  { runtime_codegen_env : CodegenEnv.t\n  ; runtime_contract_offsets : int Assoc.contract_id_assoc\n  (* what form should the constructor code be encoded?\n     1. pseudo program.  easy\n     2. pseudo codegen_env.  maybe uniform\n   *)\n  }\n\nlet empty_runtime_compiled cid_lookup layouts =\n  { runtime_codegen_env = (CodegenEnv.empty_env cid_lookup layouts)\n  ; runtime_contract_offsets = []\n  }\n\nlet compile_constructor ((lst, cid) : (Syntax.typ Syntax.contract Assoc.contract_id_assoc * Assoc.contract_id)) : constructor_compiled =\n  { constructor_codegen_env = codegen_constructor_bytecode (lst, cid)\n  ; constructor_interface = Contract.contract_interface_of (List.assoc cid lst)\n  ; constructor_contract = List.assoc cid lst\n  }\n\nlet compile_constructors (contracts : Syntax.typ Syntax.contract Assoc.contract_id_assoc)\n    : constructor_compiled Assoc.contract_id_assoc =\n  Assoc.pair_map (fun cid _ -> compile_constructor (contracts, cid)) contracts\n\nlet initial_runtime_compiled (cid_lookup : string -> Assoc.contract_id) layouts : runtime_compiled =\n  let ce = CodegenEnv.empty_env cid_lookup layouts in\n  let ce = get_contract_pc ce in\n  let ce = append_instruction ce JUMP in\n  { runtime_codegen_env = ce\n  ; runtime_contract_offsets = []\n  }\n\nlet push_destination_for (ce : CodegenEnv.t)\n                         (cid : Assoc.contract_id)\n                         (case_signature : case_header) =\n  append_instruction ce\n  (PUSH32 (CaseOffsetInRuntimeCode (cid, case_signature)))\n\nlet add_dispatcher_for_a_usual_case le ce contract_id case_signature\n  =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce DUP1 in\n  let ce = push_signature_code ce case_signature in\n  let ce = append_instruction ce EQ in\n  let ce = push_destination_for ce contract_id (UsualCaseHeader case_signature) in\n  let ce = append_instruction ce JUMPI in\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n\nlet add_dispatcher_for_default_case le ce contract_id =\n  let original_stack_size = stack_size ce in\n  let ce = push_destination_for ce contract_id DefaultCaseHeader in\n  let ce = append_instruction ce JUMP in\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n\nlet push_word_from_input_data_at_byte ce b =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH32 b) in\n  let ce = append_instruction ce CALLDATALOAD in\n  let () = assert (stack_size ce = original_stack_size + 1) in\n  ce\n\nlet stack_top_shift_right ce amount =\n  let original_stack_size = stack_size ce in\n  let ce = append_instruction ce (PUSH1 (Int amount)) in\n  let ce = append_instruction ce (PUSH1 (Int 2)) in\n  let ce = append_instruction ce EXP in\n  let ce = append_instruction ce SWAP1 in\n  let ce = append_instruction ce DIV in\n  let () = assert (stack_size ce = original_stack_size) in\n  ce\n\nlet add_throw ce =\n  (* Just using the same method as solc. *)\n  let ce = append_instruction ce (PUSH1 (Int 2)) in\n  let ce = append_instruction ce JUMP in\n  ce\n\nlet add_dispatcher le ce contract_id contract =\n  let original_stack_size = stack_size ce in\n\n  (* load the first four bytes of the input data *)\n  let ce = push_word_from_input_data_at_byte ce (Int 0) in\n  let ce = stack_top_shift_right ce Ethereum.(word_bits - signature_bits) in\n  let () = assert (stack_size ce = original_stack_size + 1) in\n  let case_signatures = List.map (fun x -> x.Syntax.case_header) contract.contract_cases in\n\n  let usual_case_headers = WrapList.filter_map\n                             (fun h -> match h with DefaultCaseHeader -> None |\n                                                    UsualCaseHeader u -> Some u\n                             ) case_signatures in\n  let ce = List.fold_left\n             (fun ce case_signature ->\n               add_dispatcher_for_a_usual_case le ce contract_id case_signature)\n             ce usual_case_headers in\n  let ce = append_instruction ce POP in (* the signature in input is not necessary anymore *)\n  let ce =\n    if List.exists (fun h -> match h with DefaultCaseHeader -> true | _ -> false) case_signatures then\n      add_dispatcher_for_default_case le ce contract_id\n    else add_throw ce\n  in\n  (le, ce)\n\nlet add_case_destination ce (cid : Assoc.contract_id) (h : Syntax.case_header) =\n  let new_label = Label.new_label () in\n  let ce = append_instruction ce (JUMPDEST new_label) in\n  let () = EntrypointDatabase.(register_entrypoint (Case (cid, h)) new_label) in\n  ce\n\n(** [prepare_words_on_stack le ce [arg0 arg1]] evaluates\n * [arg1] and then [arg0] and puts them onto the stack.\n * [arg0] will be the topmost element of the stack.\n *)\nlet prepare_words_on_stack le ce (args : typ exp list) =\n  (le, List.fold_right (fun arg ce' -> codegen_exp le ce' RightAligned arg) args ce)\n\nlet store_word_into_storage_location (le, ce) (arg_location : Storage.storage_location) =\n  let ce = append_instruction ce (PUSH32 (PseudoImm.Int arg_location)) in\n  let ce = append_instruction ce SSTORE in\n  (le, ce)\n\n(** [store_words_into_storage_locations le ce arg_locations] moves the topmost stack element to the\n *  location indicated by [arg_locations] and the next element to the next location and so on.\n *  The stack elements will disappear.\n *)\nlet store_words_into_storage_locations le ce arg_locations =\n  List.fold_left\n    store_word_into_storage_location\n    (le, ce) arg_locations\n\nlet set_contract_arguments le ce offset cid (args : typ exp list) =\n  let contract =\n    try contract_lookup ce cid\n    with e ->\n      let () = Printf.eprintf \"set_contract_arguments: looking up %d\\n\" cid in\n      raise e\n  in\n  let arg_locations : Storage.storage_location list = LayoutInfo.arg_locations offset contract in\n  let () = assert (List.length arg_locations = List.length args) in\n  let (le, ce) = prepare_words_on_stack le ce args in\n  let (le, ce) = store_words_into_storage_locations le ce arg_locations in\n  (* TODO\n   * In a special case where no movements are necessary, we can then skip these arguments.\n   *)\n  (le, ce)\n\nlet set_continuation_to_function_call le ce layout (fcall, typ_exp) =\n  let head : string = fcall.call_head in\n  let args : typ exp list = fcall.call_args in\n  let cid =\n    try\n      cid_lookup ce head\n    with Not_found ->\n      let () = Printf.eprintf \"contract of name %s not found\\n%!\" head in\n      raise Not_found\n  in\n  let ce = set_contract_pc ce cid in\n  let offset = layout.LayoutInfo.storage_constructor_arguments_begin cid in\n  let (le, ce) =\n    try\n      set_contract_arguments le ce offset cid args\n    with e ->\n      let () = Printf.eprintf \"name of contract: %s\\n\" head in\n      let () = Printf.eprintf \"set_continuation_to_function_call cid: %d\\n\" cid in\n      raise e\n  in\n  (le, ce)\n\n(*\n * set_continuation sets the storage contents.\n * So that the next message call would start from the continuation.\n *)\nlet set_continuation le ce (layout : LayoutInfo.layout_info) (cont_exp, typ_exp) =\n  let original_stack_size = stack_size ce in\n  let (le, ce) =\n    match cont_exp with\n    | FunctionCallExp fcall -> set_continuation_to_function_call le ce layout (fcall, typ_exp)\n    | _ -> failwith \"strange_continuation\" in\n  let () = assert (stack_size ce = original_stack_size) in\n  (le, ce)\n\n(*\n * Before this, the stack contains\n * ..., value (depends on typ).\n * The value would be stored in memory\n * After this, the stack contains\n * ..., size_in_bytes, offset_in_memory\n *)\nlet move_stack_top_to_memory typ le ce =\n  let () = assert (size_of_typ typ <= 32) in\n  (* ..., value *)\n  let ce = append_instruction ce (PUSH1 (PseudoImm.Int 32)) in\n  (* ..., value, 32 *)\n  let ce = append_instruction ce DUP1 in\n  (* ..., value, 32, 32 *)\n  let ce = push_allocated_memory ce in\n  (* ..., value, 32, addr *)\n  let ce = append_instruction ce SWAP2 in\n  (* ..., addr, 32, value *)\n  let ce = append_instruction ce DUP3 in\n  (* ..., addr, 32, value, addr *)\n  let ce = append_instruction ce MSTORE in\n  (* ..., addr, 32 *)\n  let ce = append_instruction ce SWAP1 in\n  (* ..., 32, addr *)\n  ce\n\n(*\n * after this, the stack contains\n * ..., size, offset_in_memory\n *)\nlet place_exp_in_memory le ce packing ((e, typ) : typ exp) =\n  let original_stack_size = stack_size ce in\n  let alignment = match packing with\n    | ABIPacking -> RightAligned\n    | TightPacking -> LeftAligned in\n  let ce = codegen_exp le ce alignment (e, typ) in\n  let () = assert (stack_size ce = 1 + original_stack_size) in\n  (* the stack layout depends on typ *)\n  let ce = move_stack_top_to_memory typ le ce in\n  let () = assert (stack_size ce = 2 + original_stack_size) in\n  le, ce\n\n(*\n * When called on [a, b, c], a shoud occupy the smallest address, and c should occupy the largest address.\n * after this, the stack contains\n * ..., size, offset_in_memory\n *)\nlet rec place_exps_in_memory le ce packing (exps : typ exp list) =\n  match exps with\n  | [] ->\n     let ce = append_instruction ce (PUSH1 (Int 0)) in\n     let ce = append_instruction ce (PUSH1 (Int 0)) in\n     le, ce\n  | exp :: rest ->\n     let le, ce = place_exp_in_memory le ce packing exp in\n     (* stack : [size, offset] *)\n     let ce = append_instruction ce SWAP1 in\n     (* stack : [offset, size] *)\n     let le, ce = place_exps_in_memory le ce packing rest in (* this recursion is a bit awkward *)\n     (* stack : [offset, size, size', offset] *)\n     let ce = append_instruction ce POP in\n     (* stack : [offset, size, size'] *)\n     let ce = append_instruction ce ADD in\n     (* stack : [offset, size_sum] *)\n     let ce = append_instruction ce SWAP1 in\n     (* stack : [size_sum, offset] *)\n     le, ce\n\n(*\n * return_mem_content assumes the stack left after place_exp_in_memory\n * ..., size, offset_in_memory\n *)\nlet return_mem_content le ce =\n  append_instruction ce RETURN\n\nlet add_return le ce (layout : LayoutInfo.layout_info) ret =\n  let original_stack_size = stack_size ce in\n  let e = ret.return_exp in\n  let c = ret.return_cont in\n  let (le, ce) = set_continuation le ce layout c in\n  let ce = match e with\n    | Some e ->\n       let (le, ce) = place_exp_in_memory le ce ABIPacking e in\n       return_mem_content le ce\n    | None ->\n       append_instruction ce STOP\n  in\n  let () = assert (stack_size ce = original_stack_size) in\n  (le, ce)\n\nlet put_stacktop_into_array_access le ce layout (aa : Syntax.typ Syntax.array_access) =\n  let array = aa.Syntax.array_access_array in\n  let index = aa.Syntax.array_access_index in\n  let ce = codegen_exp le ce RightAligned index in\n  (* stack : [value, index] *)\n  let ce = codegen_exp le ce RightAligned array in\n\n\n\n  (* stack : [value, index, array_seed] *)\n  let ce = keccak_cons le ce in\n  (* stack : [value, kec(array_seed ^ index)] *)\n  let ce = append_instruction ce SSTORE in\n  ce\n\nlet put_stacktop_into_lexp le ce layout l =\n  let original_stack_size = stack_size ce in\n  let ce =\n    match l with\n    | ArrayAccessLExp aa -> put_stacktop_into_array_access le ce layout aa\n    in\n  let () = assert (original_stack_size = stack_size ce + 1) in\n  ce\n\nlet add_assignment le ce layout l r =\n  let original_stack_size = stack_size ce in\n  (* produce r on the stack and then think about where to put that *)\n  let ce = codegen_exp le ce RightAligned r in\n  let () = assert (1 + original_stack_size = stack_size ce) in\n  let ce = put_stacktop_into_lexp le ce layout l in\n  let () = assert (original_stack_size = stack_size ce) in\n  (le, ce)\n\nlet push_event_signature ce event =\n  let hash = Ethereum.event_signature_hash event in\n  let ce = append_instruction ce (PUSH4 (Big (WrapBn.hex_to_big_int hash))) in\n  ce\n\nlet add_variable_init le ce layout i =\n  let position = stack_size ce in\n  let ce = codegen_exp le ce RightAligned i.Syntax.variable_init_value in\n  let name = i.Syntax.variable_init_name in\n  let loc = Location.Stack (position + 1) in\n  let le = LocationEnv.add_pair le name loc in\n  (le, ce)\n\nlet rec add_if_single le ce (layout : LayoutInfo.layout_info) cond body =\n  let jump_label_skip = Label.new_label () in\n  let original_stack_size = stack_size ce in\n  let ce = codegen_exp le ce RightAligned cond in\n  let ce = append_instruction ce ISZERO in\n  let ce = append_label ce jump_label_skip in\n  let ce = append_instruction ce JUMPI in\n  let le, ce = add_sentences le ce layout body in\n  let ce = append_instruction ce (JUMPDEST jump_label_skip) in\n  let () = assert (original_stack_size = stack_size ce) in\n  (le, ce)\nand add_if le ce (layout : LayoutInfo.layout_info) cond bodyT bodyF =\n  let jump_label_false = Label.new_label () in\n  let jump_label_end = Label.new_label () in\n  let original_stack_size = stack_size ce in\n  let ce = codegen_exp le ce RightAligned cond in\n  let ce = append_instruction ce ISZERO in\n  let ce = append_label ce jump_label_false in\n  let ce = append_instruction ce JUMPI in\n  let _, ce = add_sentences le ce layout bodyT in (* location env needs to be discarded *)\n  let ce = append_label ce jump_label_end in\n  let ce = append_instruction ce JUMP in\n  let ce = append_instruction ce (JUMPDEST jump_label_false) in\n  let _, ce = add_sentences le ce layout bodyF in (* location env needs to be discarded *)\n  let ce = append_instruction ce (JUMPDEST jump_label_end) in\n  let () = assert (original_stack_size = stack_size ce) in\n  (le, ce)\nand add_sentences le ce layout ss =\n  List.fold_left (fun (le, ce) s -> add_sentence le ce layout s) (le, ce) ss\nand add_sentence le ce (layout : LayoutInfo.layout_info) sent =\n  match sent with\n  | AbortSentence -> (le, add_throw ce)\n  | ReturnSentence ret -> add_return le ce layout ret\n  | AssignmentSentence (l, r) -> add_assignment le ce layout l r\n  | VariableInitSentence i -> add_variable_init le ce layout i\n  | IfThenOnly (cond, body) -> add_if_single le ce layout cond body (* this is a special case of the next *)\n  | IfThenElse (cond, bodyT, bodyF) ->\n     add_if le ce layout cond bodyT bodyF\n  | SelfdestructSentence exp -> add_self_destruct le ce layout exp\n  | ExpSentence exp -> add_exp_sentence le ce layout exp\n  | LogSentence (name, args, Some event) -> add_log_sentence le ce layout name args event\n  | LogSentence (name, args, None) -> failwith \"add_sentence: type check first\"\nand add_log_sentence le ce layout name (args : Syntax.typ Syntax.exp list) event =\n  let orig_stack_size = stack_size ce in\n  (* get the indexed *)\n  let (indexed_args, non_indexed_args) = Syntax.split_event_args event args in\n  (* prepare indexed arguments on the stack *)\n  let (le, ce) = prepare_words_on_stack le ce indexed_args in\n  (* prepare the event signature on the stack *)\n  let ce = push_event_signature ce event in\n  (* prepare non-indexed arguments in the memory *)\n  let (le, ce) = place_exps_in_memory le ce ABIPacking non_indexed_args in\n  (* stack : [..., size, offset] *)\n  let n = List.length indexed_args + 1 in\n  let ce = append_instruction ce (log n) in\n  (* decide N in logN *)\n  let () = assert (stack_size ce = orig_stack_size) in\n  le, ce\nand add_exp_sentence le ce layout exp =\n  let ce = codegen_exp le ce RightAligned exp in\n  let ce = append_instruction ce POP in\n  le, ce\nand add_self_destruct le ce layout exp =\n  let ce = codegen_exp le ce RightAligned exp in\n  let ce = append_instruction ce SUICIDE in\n  le, ce\n\nlet add_case_argument_locations (le : LocationEnv.t) (case : Syntax.typ Syntax.case) =\n  let additions : (string * Location.location) list = Ethereum.arguments_with_locations case in\n  let ret = LocationEnv.add_pairs le additions in\n  ret\n\nlet calldatasize_of_usual_header us =\n  let args = us.case_arguments in\n  4 (* for signature *) +\n    try WrapList.sum (List.map (fun x -> Ethereum.(interface_typ_size (interpret_interface_type x.arg_typ))) args) with\n      Invalid_argument _ -> 0\n\nlet add_case_argument_length_check ce case_header =\n  match case_header with\n  | DefaultCaseHeader -> (* no check, the choice is arguable *) ce\n  | UsualCaseHeader us ->\n     let ce = append_instruction ce (PUSH4 (Int (calldatasize_of_usual_header us))) in\n     let ce = append_instruction ce CALLDATASIZE in\n     let ce = append_instruction ce EQ in\n     let ce = append_instruction ce ISZERO in\n     let ce = append_instruction ce (PUSH1 (Int 0)) in\n     let ce = append_instruction ce JUMPI in\n     ce\n\nlet add_case (le : LocationEnv.t) (ce : CodegenEnv.t) layout (cid : Assoc.contract_id) (case : Syntax.typ Syntax.case) =\n  let ce = add_case_destination ce cid case.case_header in\n  let ce = add_case_argument_length_check ce case.case_header in\n  let le = LocationEnv.add_empty_block le in\n  let le = add_case_argument_locations le case in\n  let ((le : LocationEnv.t), ce) =\n    List.fold_left\n      (fun ((le : LocationEnv.t), ce) sent -> add_sentence le ce layout sent)\n      (le, ce) case.case_body in\n  (le, ce)\n\nlet codegen_append_contract_bytecode\n      le ce layout\n      ((cid, contract) : Assoc.contract_id * Syntax.typ Syntax.contract) =\n  (* jump destination for the contract *)\n  let entry_label = Label.new_label () in\n  let ce = append_instruction ce (JUMPDEST entry_label) in\n  (* update the entrypoint database with (id, pc) pair *)\n  let () = EntrypointDatabase.(register_entrypoint\n                                 (Contract cid) entry_label) in\n\n  let ce = initialize_memory_allocator ce in\n\n  (* add jumps to the cases *)\n  let (le, ce) = add_dispatcher le ce cid contract in\n\n  (* add the cases *)\n  let cases = contract.Syntax.contract_cases in\n  let (le, ce) = List.fold_left\n                   (fun (le,ce) case -> add_case le ce layout cid case)\n                   (le, ce) cases in\n\n  ce\n\nlet append_runtime layout (prev : runtime_compiled)\n                   ((cid : Assoc.contract_id), (contract : Syntax.typ Syntax.contract))\n                   : runtime_compiled =\n  { runtime_codegen_env = codegen_append_contract_bytecode (LocationEnv.runtime_initial_env contract) prev.runtime_codegen_env layout (cid, contract)\n  ; runtime_contract_offsets = Assoc.insert cid (CodegenEnv.code_length prev.runtime_codegen_env) prev.runtime_contract_offsets\n  }\n\nlet compile_runtime layout (contracts : Syntax.typ Syntax.contract Assoc.contract_id_assoc)\n    : runtime_compiled =\n  List.fold_left (append_runtime layout) (initial_runtime_compiled (cid_lookup_in_assoc contracts) contracts) contracts\n\nlet layout_info_from_constructor_compiled (cc : constructor_compiled) : LayoutInfo.contract_layout_info =\n  LayoutInfo.layout_info_of_contract cc.constructor_contract (CodegenEnv.ce_program cc.constructor_codegen_env)\n\nlet sizes_of_constructors (constructors : constructor_compiled Assoc.contract_id_assoc) : int list =\n  let lengths = Assoc.map (fun cc -> CodegenEnv.code_length cc.constructor_codegen_env) constructors in\n  let lengths = List.sort (fun a b -> compare (fst a) (fst b)) lengths in\n  List.map snd lengths\n\nlet rec calculate_offsets_inner ret current lst =\n  match lst with\n  | [] -> List.rev ret\n  | hd::tl ->\n     (* XXX: fix the append *)\n     calculate_offsets_inner (current :: ret) (current + hd) tl\n\nlet calculate_offsets initial lst =\n  calculate_offsets_inner [] initial lst\n\nlet layout_info_from_runtime_compiled (rc : runtime_compiled) (constructors : constructor_compiled Assoc.contract_id_assoc) : LayoutInfo.runtime_layout_info =\n  let sizes_of_constructors = sizes_of_constructors constructors in\n  let offsets_of_constructors = calculate_offsets (CodegenEnv.code_length rc.runtime_codegen_env) sizes_of_constructors in\n  let sum_of_constructor_sizes = WrapList.sum sizes_of_constructors in\n  LayoutInfo.(\n    { runtime_code_size = sum_of_constructor_sizes + CodegenEnv.code_length rc.runtime_codegen_env\n    ; runtime_offset_of_contract_id = rc.runtime_contract_offsets\n    ; runtime_size_of_constructor = Assoc.list_to_contract_id_assoc sizes_of_constructors\n    ; runtime_offset_of_constructor = Assoc.list_to_contract_id_assoc offsets_of_constructors\n    })\n\nlet programs_concat_reverse_order (programs : 'imm Evm.program list) =\n  let rev_programs = List.rev programs in\n  List.concat rev_programs\n\n(** constructors_packed concatenates constructor code.\n *  Since the code is stored in the reverse order, the concatenation is also reversed.\n *)\nlet constructors_packed layout (constructors : constructor_compiled Assoc.contract_id_assoc) =\n  let programs = Assoc.map (fun cc -> CodegenEnv.ce_program cc.constructor_codegen_env) constructors in\n  let programs = List.sort (fun a b -> compare (fst a) (fst b)) programs in\n  let programs = List.map snd programs in\n  programs_concat_reverse_order programs\n\nlet compose_bytecode (constructors : constructor_compiled Assoc.contract_id_assoc)\n                     (runtime : runtime_compiled) (cid : Assoc.contract_id)\n    : WrapBn.t Evm.program =\n  let contracts_layout_info : (Assoc.contract_id * LayoutInfo.contract_layout_info) list =\n    List.map (fun (id, const) -> (id, layout_info_from_constructor_compiled const)) constructors in\n  let runtime_layout = layout_info_from_runtime_compiled runtime constructors in\n  let layout = LayoutInfo.construct_post_layout_info contracts_layout_info runtime_layout in\n  let pseudo_constructor = Assoc.choose_contract cid constructors in\n  let imm_constructor = LayoutInfo.realize_pseudo_program layout cid (CodegenEnv.ce_program pseudo_constructor.constructor_codegen_env) in\n  let pseudo_runtime_core = CodegenEnv.ce_program runtime.runtime_codegen_env in\n  (* XXX: This part is somehow not modular. *)\n  (* Sicne the code is stored in the reverse order, the concatenation is also reversed. *)\n  let imm_runtime = LayoutInfo.realize_pseudo_program layout cid ((constructors_packed layout constructors)@pseudo_runtime_core) in\n  (* the code is stored in the reverse order *)\n  imm_runtime@imm_constructor\n\nlet compose_runtime_bytecode (constructors : constructor_compiled Assoc.contract_id_assoc)\n                     (runtime : runtime_compiled)\n    : WrapBn.t Evm.program =\n  let contracts_layout_info : (Assoc.contract_id * LayoutInfo.contract_layout_info) list =\n    List.map (fun (id, const) -> (id, layout_info_from_constructor_compiled const)) constructors in\n  let runtime_layout = layout_info_from_runtime_compiled runtime constructors in\n  let layout = LayoutInfo.construct_post_layout_info contracts_layout_info runtime_layout in\n  (* TODO: 0 in the next line is a bit ugly. *)\n  let imm_runtime = LayoutInfo.realize_pseudo_program layout 0 ((constructors_packed layout constructors)@(CodegenEnv.ce_program runtime.runtime_codegen_env)) in\n  imm_runtime\n"
  },
  {
    "path": "src/codegen/codegen.mldylib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 2e0624f260757657eae4c2d0f51f273f)\nCodegenEnv\nCodegen\nEntrypointDatabase\nLayoutInfo\nLocationEnv\nParse\n# OASIS_STOP\n"
  },
  {
    "path": "src/codegen/codegen.mli",
    "content": "type alignment = LeftAligned | RightAligned\n\n(** [codegen_exp original_env exp]\n * is a new codegenEnv where a stack element is pushed, whose\n * value is the evaluation of exp *)\nval codegen_exp :\n  LocationEnv.t ->\n  CodegenEnv.t ->\n  alignment ->\n  Syntax.typ Syntax.exp ->\n  CodegenEnv.t\n\nval codegen_sentence :\n  CodegenEnv.t ->\n  Syntax.typ Syntax.sentence -> (* is this enough? also add sentence Id's around?\n                   * I think this is enough.\n                   *)\n  CodegenEnv.t\n\ntype constructor_compiled =\n  { constructor_codegen_env : CodegenEnv.t\n  ; constructor_interface : Contract.contract_interface\n  ; constructor_contract : Syntax.typ Syntax.contract\n  }\n\nval compile_constructor :\n  (Syntax.typ Syntax.contract Assoc.contract_id_assoc *\n   Assoc.contract_id) -> constructor_compiled\n\ntype runtime_compiled =\n  { runtime_codegen_env : CodegenEnv.t\n  ; runtime_contract_offsets : int Assoc.contract_id_assoc\n  }\n\nval compile_runtime :\n  LayoutInfo.layout_info ->\n  Syntax.typ Syntax.contract Assoc.contract_id_assoc -> runtime_compiled\n\n(* TODO: remove from the interface.\n * Use instead compile_constructor *)\nval codegen_constructor_bytecode :\n  (Syntax.typ Syntax.contract Assoc.contract_id_assoc *\n   Assoc.contract_id) ->\n  ((* LocationEnv.location_env * *)\n     CodegenEnv.t (* containing the program *))\n\nval compile_constructors :\n  Syntax.typ Syntax.contract Assoc.contract_id_assoc ->\n  constructor_compiled Assoc.contract_id_assoc\n\nval layout_info_from_constructor_compiled : constructor_compiled -> LayoutInfo.contract_layout_info\n\nval layout_info_from_runtime_compiled : runtime_compiled -> constructor_compiled Assoc.contract_id_assoc -> LayoutInfo.runtime_layout_info\n\n(** The combination of the constructor_bytecode and the runtime_bytecode **)\nval codegen_bytecode :\n  Syntax.typ Syntax.contract ->\n  PseudoImm.pseudo_imm Evm.program\n\nval move_info_around :\n  (* assumption *) CodegenEnv.t ->\n  (* goal *)       LocationEnv.t ->\n                   CodegenEnv.t\n\n\nval compose_bytecode : constructor_compiled Assoc.contract_id_assoc ->\n                       runtime_compiled -> Assoc.contract_id ->\n                       WrapBn.t Evm.program\n\nval compose_runtime_bytecode :\n  constructor_compiled Assoc.contract_id_assoc ->\n  runtime_compiled -> WrapBn.t Evm.program\n"
  },
  {
    "path": "src/codegen/codegen.mllib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 2e0624f260757657eae4c2d0f51f273f)\nCodegenEnv\nCodegen\nEntrypointDatabase\nLayoutInfo\nLocationEnv\nParse\n# OASIS_STOP\n"
  },
  {
    "path": "src/codegen/codegenEnv.ml",
    "content": "type t =\n  { ce_stack_size: int\n  ; ce_program: PseudoImm.pseudo_imm Evm.program\n  ; ce_cid_lookup : string -> Assoc.contract_id\n  ; ce_contracts : Syntax.typ Syntax.contract Assoc.contract_id_assoc\n  }\n\nlet ce_program m = m.ce_program\n\nlet empty_env cid_lookup contracts =\n  { ce_stack_size = 0\n  ; ce_program = Evm.empty_program\n  ; ce_cid_lookup = cid_lookup\n  ; ce_contracts = contracts\n  }\n\nlet code_length ce =\n  Evm.size_of_program ce.ce_program\n\nlet stack_size ce = ce.ce_stack_size\n\nlet set_stack_size ce i =\n  { ce with ce_stack_size = i }\n\nlet append_instruction\n  (orig : t) (i : PseudoImm.pseudo_imm Evm.instruction) : t =\n  if orig.ce_stack_size < Evm.stack_eaten i then\n    failwith \"stack underflow\"\n  else\n    let () = (match i with\n                Evm.JUMPDEST l ->\n                begin\n                  try ignore (Label.lookup_value l)\n                  with Not_found ->\n                       Label.register_value l (code_length orig)\n                end\n              | _ -> ()\n             ) in\n    let new_stack_size = orig.ce_stack_size - Evm.stack_eaten i + Evm.stack_pushed i in\n    if new_stack_size > 1024 then\n      failwith \"stack overflow\"\n    else\n    { ce_stack_size = new_stack_size\n    ; ce_program = Evm.append_inst orig.ce_program i\n    ; ce_cid_lookup = orig.ce_cid_lookup\n    ; ce_contracts = orig.ce_contracts\n    }\n\nlet cid_lookup ce = ce.ce_cid_lookup\n\nlet contract_lookup (ce : t) (cid : Assoc.contract_id) : Syntax.typ Syntax.contract\n  =\n  try Assoc.choose_contract cid ce.ce_contracts\n  with e ->\n    let () = Printf.eprintf \"contract_lookup failed on %d\\n%!\" cid in\n    let () = (Assoc.print_int_for_cids (fun x -> x) (Assoc.cids ce.ce_contracts)) in\n    raise e\n"
  },
  {
    "path": "src/codegen/codegenEnv.mli",
    "content": "(* codegenEnv remembers the current stack size,\n   initial storage assumtion, and\n   accumulated instructions. *)\ntype t\n\nval empty_env : (string -> Assoc.contract_id) -> (Syntax.typ Syntax.contract Assoc.contract_id_assoc) -> t\n\nval ce_program : t -> PseudoImm.pseudo_imm Evm.program\nval code_length : t -> int\n\nval stack_size : t -> int\nval set_stack_size : t -> int -> t\n\n(* for each instruction,\n * create an interface function.\n * This allows keeping track of stack size...\n *)\n\nval append_instruction :\n  t -> PseudoImm.pseudo_imm Evm.instruction -> t\n\nval cid_lookup : t -> string -> Assoc.contract_id\n\nval contract_lookup : t -> Assoc.contract_id -> Syntax.typ Syntax.contract\n"
  },
  {
    "path": "src/codegen/codegen_test.ml",
    "content": "open Syntax\nopen Codegen\n\n(* The following two functions comes from\n * https://github.com/realworldocaml/examples/tree/master/code/parsing-test\n * which is under UNLICENSE\n *)\nlet _ =\n  let dummy_cid_lookup (_ : string) = 3 in\n  let dummy_env = CodegenEnv.empty_env dummy_cid_lookup [] in\n  let dummy_l = LocationEnv.empty_env in\n  let _ = codegen_exp dummy_l dummy_env RightAligned (FalseExp, BoolType) in\n  let _ = codegen_exp dummy_l dummy_env RightAligned (TrueExp, BoolType) in\n  let _ = codegen_exp dummy_l dummy_env RightAligned (NotExp (TrueExp, BoolType), BoolType) in\n  let _ = codegen_exp dummy_l dummy_env RightAligned (NowExp, Uint256Type) in\n  Printf.printf \"Finished codgen_test.\\n\"\n"
  },
  {
    "path": "src/codegen/codegen_test2.ml",
    "content": "open Lexer\nopen Lexing\nopen Printf\nopen Syntax\nopen Codegen\n\nlet _ =\n  let lexbuf = Lexing.from_channel stdin in\n  let contracts : unit Syntax.toplevel list = Parse.parse_with_error lexbuf in\n  let contracts = Assoc.list_to_contract_id_assoc contracts in\n  let contracts : Syntax.typ Syntax.toplevel Assoc.contract_id_assoc = Type.assign_types contracts in\n  let contracts = Assoc.filter_map (fun x -> match x with\n                                             | Contract x -> Some x\n                                             | _ -> None) contracts in\n  let () = match contracts with\n  | [] -> ()\n  | _ ->\n     let (env : CodegenEnv.t)\n       = codegen_constructor_bytecode (contracts, fst (List.hd contracts)) in\n     let constructor_program = CodegenEnv.ce_program env in\n     let () = Printf.printf \"=====constructor for first contract=====\\n\" in\n     let () = Evm.print_pseudo_program constructor_program in\n     let () = Printf.printf \"=====runtime code (common to all contracts)=====\\n\" in\n     let constructors : constructor_compiled Assoc.contract_id_assoc = compile_constructors contracts in\n     let contracts_layout_info : (Assoc.contract_id * LayoutInfo.contract_layout_info) list =\n       List.map (fun (id, const) -> (id, layout_info_from_constructor_compiled const)) constructors in\n     let layout = LayoutInfo.construct_layout_info contracts_layout_info in\n     let runtime_compiled = compile_runtime layout contracts in\n     let runtime_ce = runtime_compiled.runtime_codegen_env in\n     let () = Evm.print_pseudo_program (CodegenEnv.ce_program runtime_ce) in\n     let () = Printf.printf \"=====layout_info (common to all contracts)=====\\n\" in\n     let layout = LayoutInfo.construct_layout_info contracts_layout_info in\n     let () = LayoutInfo.print_layout_info layout in\n     let () = Printf.printf \"=====bytecode (with the constructor for first contract)=====\\n\" in\n     let bytecode : WrapBn.t Evm.program =\n       compose_bytecode constructors runtime_compiled (fst (List.hd contracts)) in\n     let () = Evm.print_imm_program bytecode in\n     let () = Printf.printf \"=====runtime bytecode=====\\n\" in\n     let runtime_bytecode : WrapBn.t Evm.program =\n       compose_runtime_bytecode constructors runtime_compiled in\n     let () = Evm.print_imm_program runtime_bytecode in\n     () in\n  Printf.printf \"Finished codgen_test2.\\n\"\n"
  },
  {
    "path": "src/codegen/entrypointDatabase.ml",
    "content": "type entrypoint =\n  | Contract of Assoc.contract_id\n  | Case of Assoc.contract_id * Syntax.case_header\n\nlet store : (entrypoint * Label.label) list ref = ref []\n\nlet register_entrypoint (k : entrypoint) (v : Label.label) : unit =\n  store := (k, v) :: !store\n\nlet lookup_entrypoint (k : entrypoint) : Label.label =\n  List.assoc k !store\n"
  },
  {
    "path": "src/codegen/entrypointDatabase.mli",
    "content": "type entrypoint =\n  | Contract of Assoc.contract_id\n  | Case of Assoc.contract_id * Syntax.case_header\n\nval register_entrypoint : entrypoint -> Label.label -> unit\nval lookup_entrypoint : entrypoint -> Label.label\n"
  },
  {
    "path": "src/codegen/layoutInfo.ml",
    "content": "(* Layout information that should be available after the constructor compilation finishes *)\ntype layout_info =\n  { contract_ids : Assoc.contract_id list\n  ; constructor_code_size : Assoc.contract_id -> int\n    (* numbers about the storage *)\n    (* The storage during the runtime looks like this: *)\n    (* |current pc (might be entry_pc_of_current_contract)|array seed counter|pod contract argument0|pod contract argument1|...\n       |array0's seed|array1's seed| *)\n    (* In addition, array elements are placed at the same location as in Solidity *)\n\n  ; storage_current_pc_index : int\n  ; storage_array_counter_index : int\n  ; storage_constructor_arguments_begin : Assoc.contract_id -> int\n  ; storage_constructor_arguments_size : Assoc.contract_id -> int\n  ; storage_array_seeds_begin : Assoc.contract_id -> int\n  ; storage_array_seeds_size : Assoc.contract_id -> int\n  }\n\n(* Layout information that should be available after the runtime compilation finishes. *)\ntype post_layout_info =\n  { (* The initial data is organized like this: *)\n    (* |constructor code|runtime code|constructor arguments|  *)\n    init_data_size : Assoc.contract_id -> int\n    (* runtime_coode_offset is equal to constructor_code_size *)\n  ; runtime_code_size : int\n  ; contract_offset_in_runtime_code : int Assoc.contract_id_assoc\n  (* And then, the runtime code is organized like this: *)\n  (* |dispatcher that jumps into the stored pc|runtime code for contract A|runtime code for contract B|runtime code for contract C| *)\n\n  ; constructor_in_runtime_code_offset : int Assoc.contract_id_assoc\n\n  (* And then, the runtime code for a particular contract is organized like this: *)\n  (* |dispatcher that jumps into a case|runtime code for case f|runtime code for case g| *)\n  ; l : layout_info\n  }\n\n\nlet print_layout_info l =\n  let () = Printf.printf \"layout_info\\n\" in\n  let () = Printf.printf \"  init_data_size:\" in\n  let () = Printf.printf \"\\n\" in\n  ()\n\ntype contract_layout_info =\n  { contract_constructor_code_size : int\n  ; contract_argument_size : int\n  (** the number of words that the contract arguments occupy *)\n  ; contract_num_array_seeds : int\n  (** the number of arguments that arrays *)\n  ; contract_args : Syntax.typ list\n  (** the list of argument types *)\n  }\n\ntype runtime_layout_info =\n  { runtime_code_size : int\n  ; runtime_offset_of_contract_id : int Assoc.contract_id_assoc\n  ; runtime_offset_of_constructor : int Assoc.contract_id_assoc\n  ; runtime_size_of_constructor : int Assoc.contract_id_assoc\n  }\n\nlet compute_constructor_code_size lst cid =\n  let c : contract_layout_info = Assoc.choose_contract cid lst in\n  c.contract_constructor_code_size\n\nlet compute_constructor_arguments_size lst cid =\n  let c : contract_layout_info = Assoc.choose_contract cid lst in\n  c.contract_argument_size\n\nlet compute_constructor_arguments_begin lst runtime cid =\n  compute_constructor_code_size lst cid +\n    runtime.runtime_code_size\n\nlet compute_init_data_size lst runtime cid =\n  compute_constructor_arguments_begin lst runtime cid +\n    compute_constructor_arguments_size lst cid\n\nlet compute_storage_constructor_arguments_begin lst cid =\n  2\n\nlet compute_storage_array_seeds_begin lst cid =\n  compute_storage_constructor_arguments_begin lst cid +\n    compute_constructor_arguments_size lst cid\n\nlet compute_storage_array_seeds_size lst cid =\n  let c = Assoc.choose_contract cid lst in\n  c.contract_num_array_seeds\n\nlet construct_layout_info\n      (lst : (Assoc.contract_id * contract_layout_info) list) : layout_info =\n  { contract_ids = List.map fst lst\n  ; constructor_code_size = compute_constructor_code_size lst\n  ; storage_current_pc_index = 0 (* This is a magic constant. *)\n  ; storage_array_counter_index = 1 (* This is also a magic constant. *)\n  ; storage_constructor_arguments_begin = compute_storage_constructor_arguments_begin lst\n  ; storage_constructor_arguments_size = compute_constructor_arguments_size lst\n  ; storage_array_seeds_begin = compute_storage_array_seeds_begin lst\n  ; storage_array_seeds_size = compute_storage_array_seeds_size lst\n  }\n\nlet construct_post_layout_info (lst : (Assoc.contract_id * contract_layout_info) list)\n      (runtime : runtime_layout_info) : post_layout_info =\n  { init_data_size = compute_init_data_size lst runtime\n  ; runtime_code_size = runtime.runtime_code_size\n  ; contract_offset_in_runtime_code = runtime.runtime_offset_of_contract_id\n  ; l = construct_layout_info lst\n  ; constructor_in_runtime_code_offset = runtime.runtime_offset_of_constructor\n  }\n\n(* Assuming the layout described above, this definition makes sense. *)\nlet runtime_code_offset (layout : layout_info) (cid : Assoc.contract_id) : int =\n  layout.constructor_code_size cid\n\nlet rec realize_pseudo_imm (layout : post_layout_info) (initial_cid : Assoc.contract_id) (p : PseudoImm.pseudo_imm) : WrapBn.t =\n  PseudoImm.(\n  match p with\n  | Big b -> b\n  | Int i -> WrapBn.big_int_of_int i\n  | DestLabel l ->\n     WrapBn.big_int_of_int (Label.lookup_value l)\n  | StorageProgramCounterIndex ->\n     WrapBn.big_int_of_int (layout.l.storage_current_pc_index)\n  | StorageConstructorArgumentsBegin cid ->\n     WrapBn.big_int_of_int (layout.l.storage_constructor_arguments_begin cid)\n  | StorageConstructorArgumentsSize cid ->\n     WrapBn.big_int_of_int (layout.l.storage_constructor_arguments_size cid)\n  | InitDataSize cid ->\n     WrapBn.big_int_of_int (layout.init_data_size cid)\n  | RuntimeCodeOffset cid ->\n     WrapBn.big_int_of_int (runtime_code_offset layout.l cid)\n  | RuntimeCodeSize ->\n     WrapBn.big_int_of_int (layout.runtime_code_size)\n  | ConstructorCodeSize cid ->\n     WrapBn.big_int_of_int (layout.l.constructor_code_size cid)\n  | ConstructorInRuntimeCodeOffset cid ->\n     WrapBn.big_int_of_int (Assoc.choose_contract cid layout.constructor_in_runtime_code_offset)\n  | ContractOffsetInRuntimeCode cid ->\n     WrapBn.big_int_of_int (Assoc.choose_contract cid layout.contract_offset_in_runtime_code)\n  | CaseOffsetInRuntimeCode (cid, case_header) ->\n     let label = EntrypointDatabase.(lookup_entrypoint (Case (cid, case_header))) in\n     let v = Label.lookup_value label in\n     WrapBn.big_int_of_int v\n  | Minus (a, b) ->\n     WrapBn.sub_big_int (realize_pseudo_imm layout initial_cid a) (realize_pseudo_imm layout initial_cid b)\n  )\n\nlet realize_pseudo_instruction (l : post_layout_info) (initial_cid : Assoc.contract_id) (i : PseudoImm.pseudo_imm Evm.instruction)\n    : WrapBn.t Evm.instruction =\n  Evm.(\n  match i with\n  | PUSH1 imm -> PUSH1 (realize_pseudo_imm l initial_cid imm)\n  | PUSH4 imm -> PUSH4 (realize_pseudo_imm l initial_cid imm)\n  | PUSH32 imm -> PUSH32 (realize_pseudo_imm l initial_cid imm)\n  | NOT -> NOT\n  | TIMESTAMP -> TIMESTAMP\n  | EQ -> EQ\n  | ISZERO -> ISZERO\n  | LT -> LT\n  | GT -> GT\n  | BALANCE -> BALANCE\n  | STOP -> STOP\n  | ADD -> ADD\n  | MUL -> MUL\n  | SUB -> SUB\n  | DIV -> DIV\n  | SDIV -> SDIV\n  | MOD -> MOD\n  | SMOD -> SMOD\n  | ADDMOD -> ADDMOD\n  | MULMOD -> MULMOD\n  | EXP -> EXP\n  | SIGNEXTEND -> SIGNEXTEND\n  | SHA3 -> SHA3\n  | ADDRESS -> ADDRESS\n  | ORIGIN -> ORIGIN\n  | CALLER -> CALLER\n  | CALLVALUE -> CALLVALUE\n  | CALLDATALOAD -> CALLDATALOAD\n  | CALLDATASIZE -> CALLDATASIZE\n  | CALLDATACOPY -> CALLDATACOPY\n  | CODESIZE -> CODESIZE\n  | CODECOPY -> CODECOPY\n  | GASPRICE -> GASPRICE\n  | EXTCODESIZE -> EXTCODESIZE\n  | EXTCODECOPY -> EXTCODECOPY\n  | POP -> POP\n  | MLOAD -> MLOAD\n  | MSTORE -> MSTORE\n  | MSTORE8 -> MSTORE8\n  | SLOAD -> SLOAD\n  | SSTORE -> SSTORE\n  | JUMP -> JUMP\n  | JUMPI -> JUMPI\n  | PC -> PC\n  | MSIZE -> MSIZE\n  | GAS -> GAS\n  | JUMPDEST l -> JUMPDEST l\n  | LOG0 -> LOG0\n  | LOG1 -> LOG1\n  | LOG2 -> LOG2\n  | LOG3 -> LOG3\n  | LOG4 -> LOG4\n  | CREATE -> CREATE\n  | CALL -> CALL\n  | CALLCODE -> CALLCODE\n  | RETURN -> RETURN\n  | DELEGATECALL -> DELEGATECALL\n  | SUICIDE -> SUICIDE\n  | SWAP1 -> SWAP1\n  | SWAP2 -> SWAP2\n  | SWAP3 -> SWAP3\n  | SWAP4 -> SWAP4\n  | SWAP5 -> SWAP5\n  | SWAP6 -> SWAP6\n  | DUP1 -> DUP1\n  | DUP2 -> DUP2\n  | DUP3 -> DUP3\n  | DUP4 -> DUP4\n  | DUP5 -> DUP5\n  | DUP6 -> DUP6\n  | DUP7 -> DUP7\n  )\n\nlet realize_pseudo_program (l : post_layout_info) (initial_cid : Assoc.contract_id) (p : PseudoImm.pseudo_imm Evm.program)\n    : WrapBn.t Evm.program\n  = List.map (realize_pseudo_instruction l initial_cid) p\n\nlet layout_info_of_contract (c : Syntax.typ Syntax.contract) (constructor_code : PseudoImm.pseudo_imm Evm.program) =\n  { contract_constructor_code_size = Evm.size_of_program constructor_code\n  ; contract_argument_size  = Ethereum.total_size_of_interface_args (List.map snd (Ethereum.constructor_arguments c))\n  ; contract_num_array_seeds = List.length (Ethereum.arrays_in_contract c)\n  ; contract_args = List.map (fun a -> a.Syntax.arg_typ) (c.Syntax.contract_arguments)\n  }\n\nlet rec arg_locations_inner (offset : int) (used_plain_args : int) (used_mapping_seeds : int)\n                            (num_of_plains : int)\n                            (args : Syntax.typ list) : Storage.storage_location list =\n  match args with\n  | [] -> []\n  | h :: t ->\n     if Syntax.is_mapping h then\n       (offset + num_of_plains + used_mapping_seeds) ::\n         arg_locations_inner offset used_plain_args (used_mapping_seeds + 1) num_of_plains t\n     else\n       (offset + used_plain_args) ::\n         arg_locations_inner offset (used_plain_args + 1) used_mapping_seeds num_of_plains t\n\n(* this needs to take storage_constructor_arguments_begin *)\nlet arg_locations (offset : int) (cntr : Syntax.typ Syntax.contract) : Storage.storage_location list =\n  let argument_types = List.map (fun a -> a.Syntax.arg_typ) cntr.Syntax.contract_arguments in\n  let () = assert (List.for_all Syntax.fits_in_one_storage_slot argument_types) in\n  let num_of_plains = Syntax.count_plain_args argument_types in\n  arg_locations_inner offset 0 0 num_of_plains argument_types\n\nlet array_locations (cntr : Syntax.typ Syntax.contract) : Storage.storage_location list =\n  let argument_types = List.map (fun a -> a.Syntax.arg_typ) cntr.Syntax.contract_arguments in\n  let () = assert (List.for_all Syntax.fits_in_one_storage_slot argument_types) in\n  let num_of_plains = Syntax.count_plain_args argument_types in\n  let total_num = List.length argument_types in\n  if total_num = num_of_plains then []\n  else\n  WrapList.range (2 + num_of_plains) (total_num + 1)\n"
  },
  {
    "path": "src/codegen/layoutInfo.mli",
    "content": "(* Layout information that should be available after the constructor compilation finishes *)\ntype layout_info =\n  { contract_ids : Assoc.contract_id list\n  ; constructor_code_size : Assoc.contract_id -> int\n    (* numbers about the storage *)\n    (* The storage during the runtime looks like this: *)\n    (* |current pc (might be entry_pc_of_current_contract)|array seed counter|pod contract argument0|pod contract argument1|...\n       |array0's seed|array1's seed| *)\n    (* In addition, array elements are placed at the same location as in Solidity *)\n\n  ; storage_current_pc_index : int\n  ; storage_array_counter_index : int\n  ; storage_constructor_arguments_begin : Assoc.contract_id -> int\n  ; storage_constructor_arguments_size : Assoc.contract_id -> int\n  ; storage_array_seeds_begin : Assoc.contract_id -> int\n  ; storage_array_seeds_size : Assoc.contract_id -> int\n  }\n\n(* Layout information that should be available after the runtime compilation finishes. *)\ntype post_layout_info =\n  { (* The initial data is organized like this: *)\n    (* |constructor code|runtime code|constructor arguments|  *)\n    init_data_size : Assoc.contract_id -> int\n    (* runtime_coode_offset is equal to constructor_code_size *)\n  ; runtime_code_size : int\n  ; contract_offset_in_runtime_code : int Assoc.contract_id_assoc\n\n    (* And then, the runtime code is organized like this: *)\n    (* |dispatcher that jumps into the stored pc|runtime code for contract A|runtime code for contract B|runtime code for contract C|\n       |constructor code for contract A|constructor code for contract B|constructor code for contract C|\n     *)\n\n  ; constructor_in_runtime_code_offset : int Assoc.contract_id_assoc\n\n    (* And then, the runtime code for a particular contract is organized like this: *)\n                                          (* |dispatcher that jumps into a case|runtime code for case f|runtime code for case g| *)\n  ; l : layout_info\n  }\n\n\n(* [Storage layout for arrays]\n * For each array argument of a contract, the storage contains a seed.\n * array[x][y] would be stored at the location sha3(sha3(seed_of(array), x), y).\n * There needs to be utility funcitons for computing this hash value and using it.\n * I think this comment should split out into its own module.\n *)\n\nval print_layout_info : layout_info -> unit\n\ntype contract_layout_info =\n  { contract_constructor_code_size : int\n  (** the number of bytes that the constructor code occupies *)\n  ; contract_argument_size : int\n  (** the number of words that the contract arguments occupy *)\n  ; contract_num_array_seeds : int\n  (** the number of arguments that are arrays; todo: remove and create a function if needed *)\n  ; contract_args : Syntax.typ list\n  (** the list of argument types *)\n  }\n\nval realize_pseudo_instruction :\n  post_layout_info -> Assoc.contract_id -> PseudoImm.pseudo_imm Evm.instruction -> WrapBn.t Evm.instruction\n\nval realize_pseudo_program :\n  post_layout_info -> Assoc.contract_id -> PseudoImm.pseudo_imm Evm.program -> WrapBn.t Evm.program\n\nval layout_info_of_contract : Syntax.typ Syntax.contract -> PseudoImm.pseudo_imm Evm.program (* constructor *) -> contract_layout_info\n\nval realize_pseudo_imm : post_layout_info -> Assoc.contract_id -> PseudoImm.pseudo_imm -> WrapBn.t\n\ntype runtime_layout_info =\n  { runtime_code_size : int\n  ; runtime_offset_of_contract_id : int Assoc.contract_id_assoc\n  ; runtime_offset_of_constructor : int Assoc.contract_id_assoc\n  ; runtime_size_of_constructor : int Assoc.contract_id_assoc\n  }\n\nval construct_layout_info : (Assoc.contract_id * contract_layout_info) list -> layout_info\n\nval construct_post_layout_info : (Assoc.contract_id * contract_layout_info) list -> runtime_layout_info -> post_layout_info\n\n(** [arg_locations offset cl] returns the list of storage locations where the arguments are stored.\n *  [offset] should be the index of the first argument\n *)\nval arg_locations : int -> Syntax.typ Syntax.contract -> Storage.storage_location list\n\n(** [array_locations cr] returns the list of storage locations where the arrays are stored.\n *)\nval array_locations : Syntax.typ Syntax.contract -> Storage.storage_location list\n"
  },
  {
    "path": "src/codegen/layouts.txt",
    "content": "Storage:\n000: program counter (which contract is it running now?)\n001: n = number of words used in ABI arguments\n002 - 002+n-1: ABI arguments\n\nThe array elements are stored at\n sha3(array_id, idx)\nFor the nesting arrays,\n sha3(sha3(array_id, first_idx), second_idx)\nand so on.\n\nMemory:\n0-63 bytes are used for sha3 argument.\nThe rest is currently unusued.\n\nStack:\nusual.  The location of the currently active variables are stored in\nlocationEnv.\n\n\nContractCreation:\nas in solc, the inputs are suffixed afer the creation code.\n"
  },
  {
    "path": "src/codegen/locationEnv.ml",
    "content": "open PseudoImm\n\ntype t =\n  (string * Location.location) list list\n\nlet size l =\n  WrapList.sum (List.map List.length l)\n\nlet empty_env = []\n\nlet forget_innermost = function\n  | (_ :: older) -> older\n  | [] -> failwith \"forget_innermost: no blocks to forget\"\n\n(** [update_block [str] [new_loc] returns [None] when [str] is not found.\n *  Otherwise, it returns the updated block. *)\nlet update_block (str : string) (new_loc : Location.location)\n                 (block : (string * Location.location) list) :\n      (string * Location.location) list option\n  = failwith \"update_block\"\n\nlet update (orig : t) (str : string) (new_loc : Location.location)\n    : t option =\n  Misc.change_first (update_block str new_loc) orig\n\nlet lookup_block (search : string) (lst : (string * Location.location) list)\n    : Location.location option =\n  try\n    Some (List.assoc search lst)\n  with\n    Not_found -> None\n\nlet lookup (le : t) (search : string) : Location.location option =\n  Misc.first_some (lookup_block search) le\n\nlet add_pair (le : t) (key : string) (loc : Location.location)\n             : t =\n  match le with\n  | [] -> failwith \"add_pair: no block\"\n  | h :: t -> ((key, loc) :: h) :: t\n\nlet add_pairs (le : t) (lst : (string * Location.location) list) : t =\n  List.fold_left (fun le' (str, loc) -> add_pair le' str loc) le lst\n\nlet add_empty_block orig = [] :: orig\n\nlet stack_story_block (block : (string * Location.location) list) : int option =\n  failwith \"stack_story_block\"\n\nlet last_stack_element_recorded (le : t) =\n  match Misc.first_some stack_story_block le with\n  | Some n -> n\n  | None -> -1\n\nlet constructor_args_locations (cid : Assoc.contract_id) (args : (string * Ethereum.interface_typ) list)\n    : t\n  =\n  let total = Ethereum.total_size_of_interface_args (List.map snd args) in\n  let one_arg ((name : string), (offset : int), (size : int)) :\n        string * Location.location\n    =\n    Location.(name,\n     Code\n      { code_start = PseudoImm.(Minus (InitDataSize cid, (Int (total - offset))))\n      ; code_size =  Int size\n      }) in\n  let rec name_offset_size_list rev_acc offset (args : (string * Ethereum.interface_typ) list) =\n    match args with\n    | [] -> List.rev rev_acc\n    | (h_name, h_typ) :: t ->\n       name_offset_size_list ((h_name, offset, Ethereum.interface_typ_size h_typ) :: rev_acc)\n                             (offset + Ethereum.interface_typ_size h_typ) t\n  in\n  [List.map one_arg (name_offset_size_list [] 0 args)]\n\nlet constructor_initial_env (cid : Assoc.contract_id)\n                            (contract : Syntax.typ Syntax.contract) : t =\n  let args = Ethereum.constructor_arguments contract in\n  constructor_args_locations cid args\n\n(** [runtime_initial_t contract]\n * is a location environment that contains\n * the constructor arguments\n * after StorageConstrutorArgumentBegin *)\nlet runtime_initial_env\n      (contract : Syntax.typ Syntax.contract) : t =\n  let plain = Ethereum.constructor_arguments contract in\n  let init = add_empty_block empty_env in\n  let f (lenv, word_idx) (name, typ) =\n    let size_in_word = Ethereum.interface_typ_size typ / 32 in\n    let loc = Location.(Storage {\n                  storage_start = Int word_idx;\n                  storage_size = Int size_in_word\n                }) in\n    let new_lenv = add_pair lenv name loc in\n    (new_lenv, word_idx + size_in_word)\n  in\n  (* XXX: remove the hard coded 2 *)\n  let (le, mid) = List.fold_left f (init, 2) plain in\n  let arrays = Ethereum.arrays_in_contract contract in (* XXX: refactor the repetition *)\n  let g (lenv, word_idx) (name, _, _) =\n    let size_in_word = 1 in\n    let loc = Location.(Storage {\n                            storage_start = Int word_idx;\n                            storage_size = Int size_in_word\n              }) in\n    let new_lenv = add_pair lenv name loc in\n    (new_lenv, word_idx + size_in_word) in\n  let (le, _) = List.fold_left g (le, mid) arrays in\n  le\n"
  },
  {
    "path": "src/codegen/locationEnv.mli",
    "content": "type t\n\nval empty_env : t\nval forget_innermost : t -> t\nval add_empty_block : t -> t\n\n(** should maintain the uniqueless of [string] in the environment. *)\nval add_pair : t -> string (* ?? *) ->\n               Location.location -> t\nval add_pairs : t -> (string * Location.location) list -> t\nval lookup : t -> string ->\n             Location.location option\n\n(** [last_stack_element_recorded = 3] means the third deepest element of the\n * stack is kept track in the t structure.\n * The caller is free to pop anything shallower *)\nval last_stack_element_recorded : t -> int\n\n(** [update] returns [None] when the string is not in the environment. *)\nval update : t -> string ->\n             Location.location -> t option\n\n(** [size l] returns the number of entries in [l] *)\nval size : t -> int\n\n(** Nothing similar to typeEnv.add_block.  Add elements one by one. *)\n\n\n(** {2} concrete locationEnv instances *)\n\n(** [constructor_initial_env contract]\n *  returns the location environment that contains\n *  the expected input arguments at the end of the\n *  bytecode *)\nval constructor_initial_env :\n  Assoc.contract_id -> Syntax.typ Syntax.contract -> t\n\n(** [runtime_initial_env specifies\n * where the state variables should be found\n * when the runtie code starts.\n * The deployment bytecode must establish this.\n * Storage index 0 is used for contract dispatching.\n * The following indices are used to store the\n * state variables.\n *)\nval runtime_initial_env :\n  Syntax.typ Syntax.contract -> t\n\n(** [constructor_args_locations constract] returns\n *  a location environment that only contains\n *  the constructor arguments appended at the end of\n *  the code. *)\nval constructor_args_locations :\n  Assoc.contract_id -> (string * Ethereum.interface_typ) list -> t\n"
  },
  {
    "path": "src/codegen/parse.ml",
    "content": "open Lexer\nopen Lexing\nopen Printf\n\n(* The following two functions comes from\n * https://github.com/realworldocaml/examples/tree/master/code/parsing-test\n * which is under UNLICENSE\n *)\nlet print_position outx lexbuf =\n  let pos = lexbuf.lex_curr_p in\n  fprintf outx \"%s:%d:%d\" pos.pos_fname\n    pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)\n\nlet parse_with_error lexbuf =\n  try Parser.file Lexer.read lexbuf with\n  | SyntaxError msg ->\n    fprintf stderr \"%a: %s\\n\" print_position lexbuf msg;\n    exit (-1)\n  | Parser.Error ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n  | _ ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n"
  },
  {
    "path": "src/codegen/parse.mli",
    "content": "val parse_with_error : Lexing.lexbuf -> unit Syntax.toplevel list\n"
  },
  {
    "path": "src/cross-platform/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: c13f891232d5c3e0d504b5e1b0eb0164)\nversion = \"0.0.02\"\ndescription = \"A compiler targeting Ethereum Virtual Machine\"\nrequires = \"batteries cryptokit hex\"\narchive(byte) = \"cross-platform.cma\"\narchive(byte, plugin) = \"cross-platform.cma\"\narchive(native) = \"cross-platform.cmxa\"\narchive(native, plugin) = \"cross-platform.cmxs\"\nexists_if = \"cross-platform.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/cross-platform/cross-platform.mldylib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 54339adac6e4801bdd3f49aa4a6fd723)\nRope\nWrapBnNative\nWrapCryptokitNative\nWrapListNative\nWrapStringNative\n# OASIS_STOP\n"
  },
  {
    "path": "src/cross-platform/cross-platform.mllib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 54339adac6e4801bdd3f49aa4a6fd723)\nRope\nWrapBnNative\nWrapCryptokitNative\nWrapListNative\nWrapStringNative\n# OASIS_STOP\n"
  },
  {
    "path": "src/cross-platform/rope.ml",
    "content": "(* Mostly copied from https://github.com/Chris00/ocaml-rope/blob/master/src/rope.ml\nParts that are modified are marked with \"Modified\" and commented out *)\n\n(* File: rope.ml\n\n   Copyright (C) 2007\n\n     Christophe Troestler\n     email: Christophe.Troestler@umh.ac.be\n     WWW: http://math.umh.ac.be/an/software/\n\n   This library is free software; you can redistribute it and/or modify\n   it under the terms of the GNU Lesser General Public License version 2.1 or\n   later as published by the Free Software Foundation, with the special\n   exception on linking described in the file LICENSE.\n\n   This library is distributed in the hope that it will be useful, but\n   WITHOUT ANY WARRANTY; without even the implied warranty of\n   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file\n   LICENSE for more details. *)\n\n(** Rope implementation inspired from :\n\n    Hans Boehm, Russ Atkinson, Michael Plass, \"Ropes: an alternative\n    to strings\", Software Practice and Experience 25, vol. 12 (1995),\n    pp. 1315-1330.\n\n    http://www.cs.ubc.ca/local/reading/proceedings/spe91-95/spe/vol25/issue12/spe986.pdf *)\n\n(* TODO:\n   - Regexp (maybe using Jérôme Vouillon regexp lib ?\n     http://www.pps.jussieu.fr/~vouillon/)\n\n   - Camomille interop. (with phantom types for encoding ??)\n     See also the OSR http://cocan.org/osr/unicode_library\n*)\n\n\nlet min i j = if (i:int) < j then i else j\nlet max i j = if (i:int) > j then i else j\n\nexception Out_of_bounds of string\n\n(* One assumes throughout that the length is a representable\n   integer.  Public functions that allow to construct larger ropes\n   must check this. *)\ntype t =\n  | Sub of string * int * int\n      (* (s, i0, len) where only s.[i0 .. i0+len-1] is used by the\n         rope.  [len = 0] is forbidden, unless the rope has 0 length\n         (i.e. it is empty).  Experiments show that this is faster\n         than [Sub of string] and does not really use more memory --\n         because splices share all nodes. *)\n  | Concat of int * int * t * int * t\n      (* [(height, length, left, left_length, right)].  This asymmetry\n         between left and right was chosen because the full length and\n         the left length are more often needed that the right\n         length. *)\n\ntype rope = t\n\nlet small_rope_length = 32\n  (** Use this as leaf when creating fresh leaves.  Also sub-ropes of\n      length [<= small_rope_length] may be flattened by [concat2].\n      This value must be quite small, typically comparable to the size\n      of a [Concat] node. *)\n\nlet make_length_pow2 = 10\nlet make_length = 1 lsl make_length_pow2\n\nlet max_flatten_length = 1024\n  (** When deciding whether to flatten a rope, only those with length [<=\n      max_flatten_length] will be. *)\n\nlet extract_sub_length = small_rope_length / 2\n  (** When balancing, copy the substrings with this length or less (=>\n      release the original string). *)\n\nlet level_flatten = 12\n  (** When balancing, flatten the rope at level [level_flatten].  The\n      sum of [min_length.(n)], [0 <= n <= level_flatten] must be of te\n      same order as [max_flatten_length]. *)\n\n(* Fibonacci numbers $F_{n+2}$.  By definition, a NON-EMPTY rope [r]\n   is balanced iff [length r >= min_length.(height r)].\n   [max_height] is the first height at which the fib. number overflow\n   the integer range. *)\nlet min_length, max_height =\n  (* Since F_{n+2} >= ((1 + sqrt 5)/2)^n, we know F_{d+2} will overflow: *)\n  let d = (3 * Sys.word_size) / 2 in\n  let m = Array.make d max_int in\n  (* See [add_nonempty_to_forest] for the reason for [max_int] *)\n  let prev = ref 0\n  and last = ref 1\n  and i = ref 0 in\n  try\n    while !i < d - 1 do\n      let curr = !last + !prev in\n      if curr < !last (* overflow *) then raise Exit;\n      m.(!i) <- curr;\n      prev := !last;\n      last := curr;\n      incr i\n    done;\n    assert false\n  with Exit -> m, !i\n\n\nlet rebalancing_height = min (max_height - 1) 60\n  (** Beyond this height, implicit balance will be done.  This value\n      allows gross inefficiencies while not being too time consuming.\n      For example, explicit rebalancing did not really improve the\n      running time on the ICFP 2007 task. *)\n  (* 32 bits: max_height - 1 = 42 *)\n\nlet empty = Sub(\"\", 0, 0)\n\nlet length = function\n  | Sub(_, _, len) -> len\n  | Concat(_,len,_,_,_) -> len\n\nlet height = function\n  | Sub(_,_,_) -> 0\n  | Concat(h,_,_,_,_) -> h\n\nlet is_empty = function\n  | Sub(_, _, len) -> len = 0\n  | _ -> false\n\nlet is_not_empty = function\n  | Sub(_, _, len) -> len <> 0\n  | _ -> true\n\n(* For debugging purposes and judging the balancing *)\nlet print =\n  let rec map_left = function\n    | [] -> []\n    | [x] -> [\"/\" ^ x]\n    | x :: tl -> (\" \" ^ x) :: map_left tl in\n  let map_right = function\n    | [] -> []\n    | x :: tl -> (\"\\\\\" ^ x) :: List.map (fun r -> \" \" ^ r) tl in\n  let rec leaves_list = function\n    | Sub(s, i0, len) -> [String.sub s i0 len]\n    | Concat(_,_, l,_, r) ->\n        map_left(leaves_list l) @ map_right(leaves_list r) in\n  fun r -> List.iter print_endline (leaves_list r)\n;;\n\nlet of_string s = Sub(s, 0, String.length s)\n(* safe: string is now immutable *)\n\n(* Since we will need to copy the string anyway, let us take this\n   opportunity to split it in small chunks for easier further\n   sharing.  In order to minimize the height, we use a simple\n   bisection scheme. *)\nlet rec unsafe_of_substring s i len =\n  if len <= small_rope_length then Sub(String.sub s i len, 0, len)\n  else\n    let len' = len / 2 in\n    let i' = i + len' in\n    let left = unsafe_of_substring s i len'\n    and right = unsafe_of_substring s i' (len - len') in\n    let h = 1 + max (height left) (height right) in\n    let ll = length left in\n    Concat(h, ll + length right, left, ll, right)\n\nlet of_substring s i len =\n  let len_s = String.length s in\n  if i < 0 || len < 0 || i > len_s - len then invalid_arg \"Rope.of_substring\";\n  (* If only a small percentage of the string is not in the rope, do\n     not cut the string in small pieces.  The case of small lengths is\n     managed by [unsafe_of_substring]. *)\n  if len >= len_s - (len / 10) then Sub(s, i, len)\n  else unsafe_of_substring s i len\n\nlet of_char c = Sub(String.make 1 c, 0, 1)\n\n(* Construct a rope from [n-1] copies of a call to [gen ofs len] of\n   length [len = make_length] and a last call with the remainder\n   length.  So the tree has [n] leaves [Sub].  The strings returned by\n   [gen ofs len] may be longer than [len] of only the first [len]\n   chars will be used. *)\nlet rec make_of_gen gen ofs len ~n =\n  if n <= 1 then\n    if len > 0 then Sub(gen ofs len, 0, len) else empty\n  else\n    let nl = n / 2 in\n    let ll = nl * max_flatten_length in\n    let l = make_of_gen gen ofs ll ~n:nl in\n    let r = make_of_gen gen (ofs + ll) (len - ll) ~n:(n - nl) in\n    Concat(1 + max (height l) (height r), len, l, ll, r)\n\nlet make_length_mask = make_length - 1\n\nlet make_n_chunks len =\n  if len land make_length_mask = 0 then len lsr make_length_pow2\n  else len lsr make_length_pow2 + 1\n\nlet make len c =\n  if len < 0 then failwith \"Rope.make: len must be >= 0\";\n  if len <= make_length then Sub(String.make len c, 0, len)\n  else\n    let base = String.make make_length c in\n    make_of_gen (fun _ _ -> base) 0 len ~n:(make_n_chunks len)\n\nlet init len f =\n  if len < 0 then failwith \"Rope.init: len must be >= 0\";\n  if len <= make_length then Sub(String.init len f, 0, len)\n  else\n    (* Do not use String.init to avoid creating a closure. *)\n    let gen ofs len =\n      let b = Bytes.create len in\n      for i = 0 to len - 1 do Bytes.set b i (f (ofs + i)) done;\n      Bytes.unsafe_to_string b in\n    make_of_gen gen 0 len ~n:(make_n_chunks len)\n\n(* [copy_to_subbytes t ofs r] copy the rope [r] to the byte range\n   [t.[ofs .. ofs+(length r)-1]].  It is assumed that [t] is long enough.\n   (This function could be a one liner with [iteri] but we want to use\n   [Bytes.blit_string] for efficiency.) *)\nlet rec copy_to_subbytes t ofs = function\n  | Sub(s, i0, len) ->\n      Bytes.blit_string s i0 t ofs len\n  | Concat(_, _, l,ll, r) ->\n      copy_to_subbytes t ofs l;\n      copy_to_subbytes t (ofs + ll) r\n\nlet to_string = function\n  | Sub(s, i0, len) ->\n     (* Optimize when the rope hold a single string. *)\n     if i0 = 0 && len = String.length s then s\n     else String.sub s i0 len\n  | r ->\n     let len = length r in\n     if len > Sys.max_string_length then\n       failwith \"Rope.to_string: rope length > Sys.max_string_length\";\n     let t = Bytes.create len in\n     copy_to_subbytes t 0 r;\n     Bytes.unsafe_to_string t\n\n(* Similar to [copy_to_subbytes] do more work to allow specifying a\n   range of [src]. *)\nlet rec unsafe_blit src srcofs dst dstofs len =\n  match src with\n  | Sub(s, i0, _) ->\n     String.blit s (i0 + srcofs) dst dstofs len\n  | Concat(_, _, l, ll, r) ->\n     let rofs = srcofs - ll in\n     if rofs >= 0 then\n       unsafe_blit r rofs dst dstofs len\n     else\n       let llen = - rofs in (* # of chars after [srcofs] in the left rope *)\n       if len <= llen then\n         unsafe_blit l srcofs dst dstofs len\n       else (* len > llen *) (\n         unsafe_blit l srcofs dst dstofs llen;\n         unsafe_blit r 0      dst (dstofs + llen) (len - llen);\n       )\n\nlet blit src srcofs dst dstofs len =\n  if len < 0 then failwith \"Rope.blit: len >= 0 required\";\n  if srcofs < 0 || srcofs > length src - len then\n    failwith \"Rope.blit: not a valid range of src\";\n  if dstofs < 0 || dstofs > Bytes.length dst - len then\n    failwith \"Rope.blit: not a valid range of dst\";\n  unsafe_blit src srcofs dst dstofs len\n\n(* Flatten a rope (avoids unecessary copying). *)\nlet flatten = function\n  | Sub(_,_,_) as r -> r\n  | r ->\n      let len = length r in\n      assert(len <= Sys.max_string_length);\n      let t = Bytes.create len in\n      copy_to_subbytes t 0 r;\n      Sub(Bytes.unsafe_to_string t, 0, len)\n\nlet rec get rope i = match rope with\n  | Sub(s, i0, len) ->\n      if i < 0 || i >= len then raise(Out_of_bounds \"Rope.get\")\n      else s.[i0 + i]\n  | Concat(_,_, l, left_len, r) ->\n      if i < left_len then get l i else get r (i - left_len)\n\n\nlet rec iter f = function\n  | Sub(s, i0, len) -> for i = i0 to i0 + len - 1 do f s.[i] done\n  | Concat(_, _, l,_, r) -> iter f l; iter f r\n\nlet rec iteri_rec f init = function\n  | Sub(s, i0, len) ->\n      let offset = init - i0 in\n      for i = i0 to i0 + len - 1 do f (i + offset) s.[i] done\n  | Concat(_, _, l,ll, r) ->\n      iteri_rec f init l;\n      iteri_rec f (init + ll) r\n\nlet iteri f r = ignore(iteri_rec f 0 r)\n\nlet rec map ~f = function\n  | Sub(s, i0, len) ->\n     let b = Bytes.create len in\n     for i = 0 to len - 1 do\n       Bytes.set b i (f (String.unsafe_get s (i0 + i)))\n     done;\n     Sub(Bytes.unsafe_to_string b, 0, len)\n  | Concat(h, len, l, ll, r) ->\n     let l = map ~f l in\n     let r = map ~f r in\n     Concat(h, len, l, ll, r)\n\nlet rec mapi_rec ~f idx0 = function\n  | Sub(s, i0, len) ->\n     let b = Bytes.create len in\n     for i = 0 to len - 1 do Bytes.set b i (f (idx0 + i) s.[i0 + i]) done;\n     Sub(Bytes.unsafe_to_string b, 0, len)\n  | Concat(h, len, l, ll, r) ->\n     let l = mapi_rec ~f idx0 l in\n     let r = mapi_rec ~f (idx0 + ll) r in\n     Concat(h, len, l, ll, r)\n\nlet mapi ~f r = mapi_rec ~f 0 r\n\n(** Balancing\n ***********************************************************************)\n\n(* Fast, no fuss, concatenation. *)\nlet balance_concat rope1 rope2 =\n  let len1 = length rope1\n  and len2 = length rope2 in\n  if len1 = 0 then rope2\n  else if len2 = 0 then rope1\n  else\n    let h = 1 + max (height rope1) (height rope2) in\n    Concat(h, len1 + len2, rope1, len1, rope2)\n\n(* Invariants for [forest]:\n   1) The concatenation of the forest (in decreasing order) with the\n   unscanned part of the rope is equal to the rope being balanced.\n   2) All trees in the forest are balanced, i.e. [forest.(n)] is empty or\n   [length forest.(n) >= min_length.(n)].\n   3) [height forest.(n) <= n] *)\n(* Add the rope [r] (usually a leaf) to the appropriate slot of\n   [forest] (according to [length r]) gathering ropes from lower\n   levels if necessary.  Assume [r] is not empty. *)\nlet add_nonempty_to_forest forest r =\n  let len = length r in\n  let n = ref 0 in\n  let sum = ref empty in\n  (* forest.(n-1) ^ ... ^ (forest.(2) ^ (forest.(1) ^ forest.(0)))\n     with [n] s.t. [min_length.(n) < len <= min_length.(n+1)].  [n]\n     is at most [max_height-1] because [min_length.(max_height) = max_int] *)\n  while len > min_length.(!n + 1) do\n    if is_not_empty forest.(!n) then (\n      sum := balance_concat forest.(!n) !sum;\n      forest.(!n) <- empty;\n    );\n    if !n = level_flatten then sum := flatten !sum;\n    incr n\n  done;\n  (* Height of [sum] at most 1 greater than what would be required\n     for balance. *)\n  sum := balance_concat !sum r;\n  (* If [height r <= !n - 1] (e.g. if [r] is a leaf), then [!sum] is\n     now balanced -- distinguish whether forest.(!n - 1) is empty or\n     not (see the cited paper pp. 1319-1320).  We now continue\n     concatenating ropes until the result fits into an empty slot of\n     the [forest]. *)\n  let sum_len = ref(length !sum) in\n  while !n < max_height && !sum_len >= min_length.(!n) do\n    if is_not_empty forest.(!n) then (\n      sum := balance_concat forest.(!n) !sum;\n      sum_len := length forest.(!n) + !sum_len;\n      forest.(!n) <- empty;\n    );\n    if !n = level_flatten then sum := flatten !sum;\n    incr n\n  done;\n  decr n;\n  forest.(!n) <- !sum\n\nlet add_to_forest forest r =\n  if is_not_empty r then add_nonempty_to_forest forest r\n\n(* Add a NON-EMPTY rope [r] to the forest *)\nlet rec balance_insert forest rope = match rope with\n  | Sub(s, i0, len) ->\n      (* If the length of the leaf is small w.r.t. the length of\n         [s], extract it to avoid keeping a ref the larger [s]. *)\n      if 25 * len <= String.length s then\n        add_nonempty_to_forest forest (Sub(String.sub s i0 len, 0, len))\n      else   add_nonempty_to_forest forest rope\n  | Concat(h, len, l,_, r) ->\n      (* FIXME: when to rebalance subtrees *)\n      if h >= max_height || len < min_length.(h) then (\n        (* sub-rope needs rebalancing *)\n        balance_insert forest l;\n        balance_insert forest r;\n      )\n      else add_nonempty_to_forest forest rope\n;;\n\nlet concat_forest forest =\n  let concat (n, sum) r =\n    let sum = balance_concat r sum in\n    (n+1, if n = level_flatten then flatten sum else sum) in\n  snd(Array.fold_left concat (0,empty) forest)\n\n\nlet balance = function\n  | Sub(s, i0, len) as r ->\n      if 0 < len && len <= extract_sub_length then\n        Sub(String.sub s i0 len, 0, len)\n      else  r\n  | r ->\n      let forest = Array.make max_height empty in\n      balance_insert forest r;\n      concat_forest forest\n\n(* Only rebalance on the height.  Also doing it when [length r\n   < min_length.(height r)] ask for too many balancing and thus is slower. *)\nlet balance_if_needed r =\n  if height r >= rebalancing_height then balance r else r\n\n\n(** \"Fast\" concat for ropes.\n **********************************************************************\n\n * Since concat is one of the few ways a rope can be constructed, it\n * must be fast.  Also, this means it is this concat which is\n * responsible for the height of small ropes (until balance kicks in\n * but the later the better).\n *)\n\nexception Relocation_failure (* Internal exception *)\n\n(* Try to relocate the [leaf] at a position that will not increase the\n   height.\n   [length(relocate_topright rope leaf _)= length rope + length leaf]\n   [height(relocate_topright rope leaf _) = height rope] *)\nlet rec relocate_topright rope leaf len_leaf = match rope with\n  | Sub(_,_,_) -> raise Relocation_failure\n  | Concat(h, len, l,ll, r) ->\n      let hr = height r + 1 in\n      if hr < h then\n        (* Success, we can insert the leaf here without increasing the height *)\n        let lr = length r in\n        Concat(h, len + len_leaf, l,ll,\n              Concat(hr, lr + len_leaf, r, lr, leaf))\n      else\n        (* Try at the next level *)\n        Concat(h, len + len_leaf, l,ll,  relocate_topright r leaf len_leaf)\n\nlet rec relocate_topleft leaf len_leaf rope = match rope with\n  | Sub(_,_,_) -> raise Relocation_failure\n  | Concat(h, len, l,ll, r) ->\n      let hl = height l + 1 in\n      if hl < h then\n        (* Success, we can insert the leaf here without increasing the height *)\n        let len_left = len_leaf + ll in\n        let left = Concat(hl, len_left, leaf, len_leaf, l) in\n        Concat(h, len_leaf + len, left, len_left, r)\n      else\n        (* Try at the next level *)\n        let left = relocate_topleft leaf len_leaf l in\n        Concat(h, len_leaf + len, left, len_leaf + ll, r)\n\n\n(* We avoid copying too much -- as this may slow down access, even if\n   height is lower. *)\nlet concat2_nonempty rope1 rope2 =\n  match rope1, rope2 with\n  | Sub(s1,i1,len1), Sub(s2,i2,len2) ->\n      let len = len1 + len2 in\n      if len <= small_rope_length then\n        let s = Bytes.create len in\n        Bytes.blit_string s1 i1 s 0 len1;\n        Bytes.blit_string s2 i2 s len1 len2;\n        Sub(Bytes.unsafe_to_string s, 0, len)\n      else\n        Concat(1, len, rope1, len1, rope2)\n  | Concat(h1, len1, l1,ll1, (Sub(s1, i1, lens1) as leaf1)), _\n      when h1 > height rope2 ->\n      let len2 = length rope2 in\n      let len = len1 + len2\n      and lens = lens1 + len2 in\n      if lens <= small_rope_length then\n        let s = Bytes.create lens in\n        Bytes.blit_string s1 i1 s 0 lens1;\n        copy_to_subbytes s lens1 rope2;\n        Concat(h1, len, l1,ll1, Sub(Bytes.unsafe_to_string s, 0, lens))\n      else begin\n        try\n          let left = relocate_topright l1 leaf1 lens1 in\n          (* [h1 = height l1 + 1] since the right branch is a leaf\n             and [height l1 = height left]. *)\n          Concat(max h1 (1 + height rope2), len, left, len1, rope2)\n        with Relocation_failure ->\n          let h2plus1 = height rope2 + 1 in\n          (* if replacing [leaf1] will increase the height or if further\n             concat will have an opportunity to add to a (small) leaf *)\n          if (h1 = h2plus1 && len2 <= max_flatten_length)\n            || len2 < small_rope_length then\n            Concat(h1 + 1, len, rope1, len1, flatten rope2)\n          else\n            (* [h1 > h2 + 1] *)\n            let right = Concat(h2plus1, lens, leaf1, lens1, rope2) in\n            Concat(h1, len, l1, ll1, right)\n      end\n  | _, Concat(h2, len2, (Sub(s2, i2, lens2) as leaf2),_, r2)\n      when height rope1 < h2 ->\n      let len1 = length rope1 in\n      let len = len1 + len2\n      and lens = len1 + lens2 in\n      if lens <= small_rope_length then\n        let s = Bytes.create lens in\n        copy_to_subbytes s 0 rope1;\n        Bytes.blit_string s2 i2 s len1 lens2;\n        Concat(h2, len, Sub(Bytes.unsafe_to_string s, 0, lens), lens, r2)\n      else begin\n        try\n          let right = relocate_topleft leaf2 lens2 r2 in\n          (* [h2 = height r2 + 1] since the left branch is a leaf\n             and [height r2 = height right]. *)\n          Concat(max (1 + height rope1) h2, len, rope1, len1, right)\n        with Relocation_failure ->\n          let h1plus1 = height rope1 + 1 in\n          (* if replacing [leaf2] will increase the height or if further\n             concat will have an opportunity to add to a (small) leaf *)\n          if (h1plus1 = h2 && len1 <= max_flatten_length)\n            || len1 < small_rope_length then\n            Concat(h2 + 1, len, flatten rope1, len1, rope2)\n          else\n            (* [h1 + 1 < h2] *)\n            let left = Concat(h1plus1, lens, rope1, len1, leaf2) in\n            Concat(h2, len, left, lens, r2)\n      end\n  | _, _ ->\n      let len1 = length rope1\n      and len2 = length rope2 in\n      let len = len1 + len2 in\n      (* Small unbalanced ropes may happen if one concat left, then\n         right, then left,...  This costs a bit of time but is a good\n         defense. *)\n      if len <= small_rope_length then\n        let s = Bytes.create len in\n        copy_to_subbytes s 0 rope1;\n        copy_to_subbytes s len1 rope2;\n        Sub(Bytes.unsafe_to_string s, 0, len)\n      else begin\n        let rope1 =\n          if len1 <= small_rope_length then flatten rope1 else rope1\n        and rope2 =\n          if len2 <= small_rope_length then flatten rope2 else rope2 in\n        let h = 1 + max (height rope1) (height rope2) in\n        Concat(h, len1 + len2, rope1, len1, rope2)\n      end\n;;\n\n\nlet concat2 rope1 rope2 =\n  let len1 = length rope1\n  and len2 = length rope2 in\n  let len = len1 + len2 in\n  if len1 = 0 then rope2\n  else if len2 = 0 then rope1\n  else begin\n    if len < len1 (* overflow *) then\n      failwith \"Rope.concat2: the length of the resulting rope exceeds max_int\";\n    let h = 1 + max (height rope1) (height rope2) in\n    if h >= rebalancing_height then\n      (* We will need to rebalance anyway, so do a simple concat *)\n      balance (Concat(h, len, rope1, len1, rope2))\n    else\n      (* No automatic rebalancing -- experimentally lead to faster exec *)\n      concat2_nonempty rope1 rope2\n  end\n;;\n\n(** Subrope\n ***********************************************************************)\n\n(** [sub_to_substring flat j i len r] copies the subrope of [r]\n    starting at character [i] and of length [len] to [flat.[j ..]]. *)\nlet rec sub_to_substring flat j i len = function\n  | Sub(s, i0, _) ->\n      Bytes.blit_string s (i0 + i) flat j len\n  | Concat(_, _, l, ll, r) ->\n      let ri = i - ll in\n      if ri >= 0 then (* only right branch *)\n        sub_to_substring flat j ri len r\n      else (* ri < 0 *)\n        let lenr = ri + len in\n        if lenr <= 0 then (* only left branch *)\n          sub_to_substring flat j i len l\n        else ( (* at least one char from the left and right branches *)\n          sub_to_substring flat j         i (-ri) l;\n          sub_to_substring flat (j - ri)  0 lenr r;\n        )\n\nlet flatten_subrope rope i len =\n  assert(len <= Sys.max_string_length);\n  let flat = Bytes.create len in\n  sub_to_substring flat 0 i len rope;\n  Sub(Bytes.unsafe_to_string flat, 0, len)\n;;\n\n(* Are lazy sub-rope nodes really needed? *)\n(* This function assumes that [i], [len] define a valid sub-rope of\n   the last arg.  *)\nlet rec sub_rec i len = function\n  | Sub(s, i0, lens) ->\n      assert(i >= 0 && i <= lens - len);\n      Sub(s, i0 + i, len)\n  | Concat(_, rope_len, l, ll, r) ->\n      let rl = rope_len - ll in\n      let ri = i - ll in\n      if ri >= 0 then\n        if len = rl then r (* => ri = 0 -- full right sub-rope *)\n        else sub_rec ri len r\n      else\n        let rlen = ri + len (* = i + len - ll *) in\n        if rlen <= 0 then (* right sub-rope empty *)\n          if len = ll then l (* => i = 0 -- full left sub-rope *)\n          else sub_rec i len l\n        else\n          (* at least one char from the left and right sub-ropes *)\n          let l' = if i = 0 then l else sub_rec i (-ri) l\n          and r' = if rlen = rl then r else sub_rec 0 rlen r in\n          let h = 1 + max (height l') (height r') in\n          (* FIXME: do we have to use this opportunity to flatten some\n             subtrees?  In any case, the height of tree we get is no\n             worse than the initial tree (but the length may be much\n             smaller). *)\n          Concat(h, len, l', -ri, r')\n\n\nlet sub rope i len =\n  let len_rope = length rope in\n  if i < 0 || len < 0 || i > len_rope - len then invalid_arg \"Rope.sub\"\n  else if len = 0 then empty\n  else if len <= max_flatten_length && len_rope >= 32768 then\n    (* The benefit of flattening such subropes (and constants) has been\n       seen experimentally.  It is not clear what the \"exact\" rule\n       should be. *)\n    flatten_subrope rope i len\n  else sub_rec i len rope\n\n\n(** String alike functions\n ***********************************************************************)\n\nlet is_space = function\n  | ' ' | '\\012' | '\\n' | '\\r' | '\\t' -> true\n  | _ -> false\n\nlet rec trim_left = function\n  | Sub(s, i0, len) ->\n     let i = ref i0 in\n     let i_max = i0 + len in\n     while !i < i_max && is_space (String.unsafe_get s !i) do incr i done;\n     if !i = i_max then empty else Sub(s, !i, i_max - !i)\n  | Concat(_, _, l, _, r) ->\n     let l = trim_left l in\n     if is_empty l then trim_left r\n     else let ll = length l in\n          Concat(1 + max (height l) (height r), ll + length r, l, ll, r)\n\nlet rec trim_right = function\n  | Sub(s, i0, len) ->\n     let i = ref (i0 + len - 1) in\n     while !i >= i0 && is_space (String.unsafe_get s !i) do decr i done;\n     if !i < i0 then empty else Sub(s, i0, !i - i0 + 1)\n  | Concat(_, _, l, ll, r) ->\n     let r = trim_right r in\n     if is_empty r then trim_right l\n     else let lr = length r in\n          Concat(1 + max (height l) (height r), ll + lr, l, ll, r)\n\nlet trim r = trim_right(trim_left r)\n\n(* Escape the range s.[i0 .. i0+len-1].  Modeled after Bytes.escaped *)\nlet escaped_sub s i0 len =\n  let n = ref 0 in\n  let i1 = i0 + len - 1 in\n  for i = i0 to i1 do\n    n := !n + (match String.unsafe_get s i with\n               | '\\\"' | '\\\\' | '\\n' | '\\t' | '\\r' | '\\b' -> 2\n               | ' ' .. '~' -> 1\n               | _ -> 4)\n  done;\n  if !n = len then Sub(s, i0, len) else (\n    let s' = Bytes.create !n in\n    n := 0;\n    for i = i0 to i1 do\n      (match String.unsafe_get s i with\n       | ('\\\"' | '\\\\') as c ->\n          Bytes.unsafe_set s' !n '\\\\'; incr n; Bytes.unsafe_set s' !n c\n       | '\\n' ->\n          Bytes.unsafe_set s' !n '\\\\'; incr n; Bytes.unsafe_set s' !n 'n'\n       | '\\t' ->\n          Bytes.unsafe_set s' !n '\\\\'; incr n; Bytes.unsafe_set s' !n 't'\n       | '\\r' ->\n          Bytes.unsafe_set s' !n '\\\\'; incr n; Bytes.unsafe_set s' !n 'r'\n       | '\\b' ->\n          Bytes.unsafe_set s' !n '\\\\'; incr n; Bytes.unsafe_set s' !n 'b'\n       | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c\n       | c ->\n          let a = Char.code c in\n          Bytes.unsafe_set s' !n '\\\\';\n          incr n;\n          Bytes.unsafe_set s' !n (Char.chr (48 + a / 100));\n          incr n;\n          Bytes.unsafe_set s' !n (Char.chr (48 + (a / 10) mod 10));\n          incr n;\n          Bytes.unsafe_set s' !n (Char.chr (48 + a mod 10));\n      );\n      incr n\n    done;\n    Sub(Bytes.unsafe_to_string s', 0, !n)\n  )\n\nlet rec escaped = function\n  | Sub(s, i0, len) -> escaped_sub s i0 len\n  | Concat(h, _, l, _, r) ->\n     let l = escaped l in\n     let ll = length l in\n     let r = escaped r in\n     Concat(h, ll + length r, l, ll, r)\n\n(* Return the index of [c] in [s.[i .. i1-1]] plus the [offset] or\n   [-1] if not found. *)\nlet rec index_string offset s i i1 c =\n  if i >= i1 then -1\n  else if s.[i] = c then offset + i\n  else index_string offset s (i+1) i1 c;;\n\n(* Return the index of [c] from position [i] in the rope or a negative\n   value if not found *)\nlet rec unsafe_index offset i c = function\n  | Sub(s, i0, len) ->\n      index_string (offset - i0) s (i0 + i) (i0 + len) c\n  | Concat(_, _, l,ll, r) ->\n      if i >= ll then unsafe_index (offset + ll) (i - ll) c r\n      else\n        let li = unsafe_index offset i c l in\n        if li >= 0 then li else unsafe_index (offset + ll) 0 c r\n\nlet index_from r i c =\n  if i < 0 || i >= length r then invalid_arg \"Rope.index_from\" else\n    let j = unsafe_index 0 i c r in\n    if j >= 0 then j else raise Not_found\n\nlet index_from_opt r i c =\n  if i < 0 || i >= length r then invalid_arg \"Rope.index_from_opt\";\n  let j = unsafe_index 0 i c r in\n  if j >= 0 then Some j else None\n\nlet index r c =\n  let j = unsafe_index 0 0 c r in\n  if j >= 0 then j else raise Not_found\n\nlet index_opt r c =\n  let j = unsafe_index 0 0 c r in\n  if j >= 0 then Some j else None\n\nlet contains_from r i c =\n  if i < 0 || i >= length r then invalid_arg \"Rope.contains_from\"\n  else unsafe_index 0 i c r >= 0\n\nlet contains r c = unsafe_index 0 0 c r >= 0\n\n(* Return the index of [c] in [s.[i0 .. i]] (starting from the\n   right) plus the [offset] or [-1] if not found. *)\nlet rec rindex_string offset s i0 i c =\n  if i < i0 then -1\n  else if s.[i] = c then offset + i\n  else rindex_string offset s i0 (i - 1) c\n\nlet rec unsafe_rindex offset i c = function\n  | Sub(s, i0, _) ->\n      rindex_string (offset - i0) s i0 (i0 + i) c\n  | Concat(_, _, l,ll, r) ->\n      if i < ll then unsafe_rindex offset i c l\n      else\n        let ri = unsafe_rindex (offset + ll) (i - ll) c r in\n        if ri >= 0 then ri else unsafe_rindex offset (ll - 1) c l\n\nlet rindex_from r i c =\n  if i < 0 || i > length r then invalid_arg \"Rope.rindex_from\" else\n    let j = unsafe_rindex 0 i c r in\n    if j >= 0 then j else raise Not_found\n\nlet rindex_from_opt r i c =\n  if i < 0 || i > length r then invalid_arg \"Rope.rindex_from_opt\";\n  let j = unsafe_rindex 0 i c r in\n  if j >= 0 then Some j else None\n\nlet rindex r c =\n  let j = unsafe_rindex 0 (length r - 1) c r in\n  if j >= 0 then j else raise Not_found\n\nlet rindex_opt r c =\n  let j = unsafe_rindex 0 (length r - 1) c r in\n  if j >= 0 then Some j else None\n\nlet rcontains_from r i c =\n  if i < 0 || i >= length r then invalid_arg \"Rope.rcontains_from\"\n  else unsafe_rindex 0 i c r >= 0\n\n\n(* Modified\nlet lowercase_ascii r = map ~f:Char.lowercase_ascii r\nlet uppercase_ascii r = map ~f:Char.uppercase_ascii r\nlet lowercase = lowercase_ascii\nlet uppercase = uppercase_ascii *)\n\nlet rec map1 f = function\n  | Concat(h, len, l, ll, r) -> Concat(h, len, map1 f l, ll, r)\n  | Sub(s, i0, len) ->\n      if len = 0 then empty else begin\n        let s' = Bytes.create len in\n        Bytes.set s' 0 (f (String.unsafe_get s i0));\n        Bytes.blit_string s (i0 + 1) s' 1 (len - 1);\n        Sub(Bytes.unsafe_to_string s', 0, len)\n      end\n\n(* Modified\nlet capitalize_ascii r = map1 Char.uppercase_ascii r\nlet uncapitalize_ascii r = map1 Char.lowercase_ascii r\nlet capitalize = capitalize_ascii\nlet uncapitalize = uncapitalize_ascii *)\n\n(** Iterator\n ***********************************************************************)\nmodule Iterator = struct\n\n  type t = {\n    rope: rope;\n    len: int; (* = length rope; avoids to recompute it again and again\n                 for bound checks *)\n    mutable i: int; (* current position in the rope; it is always a\n                       valid position of the rope or [-1]. *)\n    mutable path: (rope * int) list;\n    (* path to the current leaf with global range.  First elements are\n       closer to the leaf, last element is the full rope. *)\n    mutable current: string; (* local cache of current leaf *)\n    mutable current_g0: int;\n    (* global index of the beginning of current string.\n       i0 = current_g0 + offset *)\n    mutable current_g1: int;\n    (* global index of the char past the current string.\n       len = current_g1 - current_g0 *)\n    mutable current_offset: int; (* = i0 - current_g0 *)\n  }\n\n\n  (* [g0] is the global index (of [itr.rope]) of the beginning of the\n     node we are examining.\n     [i] is the _local_ index (of the current node) that we seek the leaf for *)\n  let rec set_current_for_index_rec itr g0 i = function\n    | Sub(s, i0, len) ->\n        assert(0 <= i && i < len);\n        itr.current <- s;\n        itr.current_g0 <- g0;\n        itr.current_g1 <- g0 + len;\n        itr.current_offset <- i0 - g0\n    | Concat(_, _, l,ll, r) ->\n        if i < ll then set_current_for_index_rec itr g0 i l\n        else set_current_for_index_rec itr (g0 + ll) (i - ll) r\n\n  let set_current_for_index itr =\n    set_current_for_index_rec itr 0 itr.i itr.rope\n\n  let rope itr = itr.rope\n\n  let make r i0 =\n    let len = length r in\n    let itr =\n      { rope = balance_if_needed r;\n        len = len;\n        i = i0;\n        path = [(r, 0)]; (* the whole rope *)\n        current = \"\"; current_offset = 0;\n        current_g0 = 0; current_g1 = 0;\n        (* empty range, important if [current] not set! *)\n      } in\n    if i0 >= 0 && i0 < len then\n      set_current_for_index itr; (* force [current] to be set *)\n    itr\n\n  let peek itr i =\n    if i < 0 || i >= itr.len then raise(Out_of_bounds \"Rope.Iterator.peek\")\n    else (\n      if itr.current_g0 <= i && i < itr.current_g1 then\n        itr.current.[i + itr.current_offset]\n      else\n        get itr.rope i (* rope get *)\n    )\n\n  let get itr =\n    let i = itr.i in\n    if i < 0 || i >= itr.len then raise(Out_of_bounds \"Rope.Iterator.get\")\n    else (\n      if i < itr.current_g0 || i >= itr.current_g1 then\n        set_current_for_index itr; (* out of local bounds *)\n      itr.current.[i + itr.current_offset]\n    )\n\n  let pos itr = itr.i\n\n  let incr itr = itr.i <- itr.i + 1\n\n  let decr itr = itr.i <- itr.i - 1\n\n  let goto itr j = itr.i <- j\n\n  let move itr k = itr.i <- itr.i + k\nend\n\n(** (In)equality\n ***********************************************************************)\n\nexception Less\nexception Greater\n\nlet compare r1 r2 =\n  let len1 = length r1 and len2 = length r2 in\n  let i1 = Iterator.make r1 0\n  and i2 = Iterator.make r2 0 in\n  try\n    for _i = 1 to min len1 len2 do (* on the common portion of [r1] and [r2] *)\n      let c1 = Iterator.get i1 and c2 = Iterator.get i2 in\n      if c1 < c2 then raise Less;\n      if c1 > c2 then raise Greater;\n      Iterator.incr i1;\n      Iterator.incr i2;\n    done;\n    (* The strings are equal on their common portion, the shorter one\n       is the smaller. *)\n    compare (len1: int) len2\n  with\n  | Less -> -1\n  | Greater -> 1\n;;\n\n(* Semantically equivalent to [compare r1 r2 = 0] but specialized\n   implementation for speed. *)\nlet equal r1 r2 =\n  let len1 = length r1 and len2 = length r2 in\n  if len1 <> len2 then false else (\n    let i1 = Iterator.make r1 0\n    and i2 = Iterator.make r2 0 in\n    try\n      for _i = 1 to len1 do (* len1 times *)\n        if Iterator.get i1 <> Iterator.get i2 then raise Exit;\n        Iterator.incr i1;\n        Iterator.incr i2;\n      done;\n      true\n    with Exit -> false\n  )\n\n(** KMP search algo\n ***********************************************************************)\nlet init_next p =\n  let m = String.length p in\n  let next = Array.make m 0 in\n  let i = ref 1 and j = ref 0 in\n  while !i < m - 1 do\n    if p.[!i] = p.[!j] then begin incr i; incr j; next.(!i) <- !j end\n    else if !j = 0 then begin incr i; next.(!i) <- 0 end else j := next.(!j)\n  done;\n  next\n\nlet search_forward_string p =\n  if String.length p > Sys.max_array_length then\n    failwith \"Rope.search_forward: string to search too long\";\n  let next = init_next p\n  and m = String.length p in\n  fun rope i0 ->\n    let i = Iterator.make rope i0\n    and j = ref 0 in\n    (try\n       (* The iterator will raise an exception of we go beyond the\n          length of the rope. *)\n       while !j < m do\n         if p.[!j] = Iterator.get i then begin Iterator.incr i; incr j end\n         else if !j = 0 then Iterator.incr i else j := next.(!j)\n       done;\n     with Out_of_bounds _ -> ());\n    if !j >= m then Iterator.pos i - m else raise Not_found\n\n\n(** Buffer\n ***********************************************************************)\n\nmodule Buffer = struct\n\n  (* The content of the buffer consists of the forest concatenated in\n     decreasing order plus (at the end) the part stored in [buf]:\n     [forest.(max_height-1) ^ ... ^ forest.(1) ^ forest.(0)\n                                                     ^ String.sub buf 0 pos]\n  *)\n  type t = {\n    mutable buf: Bytes.t;\n    buf_len: int; (* = String.length buf; must be > 0 *)\n    mutable pos: int;\n    mutable length: int; (* the length of the rope contained in this buffer\n                            -- including the part in the forest *)\n    forest: rope array; (* keeping the partial rope in a forest will\n                           ensure it is balanced at the end. *)\n  }\n\n  (* We will not allocate big buffers, if we exceed the buffer length,\n     we will cut into small chunks and add it directly to the forest.  *)\n  let create n =\n    let n =\n      if n < 1 then small_rope_length else\n        if n > Sys.max_string_length then Sys.max_string_length\n        else n in\n    { buf = Bytes.create n;\n      buf_len = n;\n      pos = 0;\n      length = 0;\n      forest = Array.make max_height empty;\n    }\n\n  let clear b =\n    b.pos <- 0;\n    b.length <- 0;\n    Array.fill b.forest 0 max_height empty\n\n  (* [reset] is no different from [clear] because we do not grow the\n     buffer. *)\n  let reset b = clear b\n\n  let add_char b c =\n    if b.length = max_int then failwith \"Rope.Buffer.add_char: \\\n\tbuffer length will exceed the int range\";\n    if b.pos >= b.buf_len then (\n      (* Buffer full, add it to the forest and allocate a new one: *)\n      add_nonempty_to_forest\n        b.forest (Sub(Bytes.unsafe_to_string b.buf, 0, b.buf_len));\n      b.buf <- Bytes.create b.buf_len;\n      Bytes.set b.buf 0 c;\n      b.pos <- 1;\n    )\n    else (\n      Bytes.set b.buf b.pos c;\n      b.pos <- b.pos + 1;\n    );\n    b.length <- b.length + 1\n\n  let unsafe_add_substring b s ofs len =\n    (* Beware of int overflow *)\n    if b.length > max_int - len then failwith \"Rope.Buffer.add_substring: \\\n\tbuffer length will exceed the int range\";\n    let buf_left = b.buf_len - b.pos in\n    if len <= buf_left then (\n      (* Enough space in [buf] to hold the substring of [s]. *)\n      String.blit s ofs b.buf b.pos len;\n      b.pos <- b.pos + len;\n    )\n    else (\n      (* Complete [buf] and add it to the forest: *)\n      Bytes.blit_string s ofs b.buf b.pos buf_left;\n      add_nonempty_to_forest\n        b.forest (Sub(Bytes.unsafe_to_string b.buf, 0, b.buf_len));\n      b.buf <- Bytes.create b.buf_len;\n      b.pos <- 0;\n      (* Add the remaining of [s] to to forest (it is already\n         balanced by of_substring, so we add is as such): *)\n      let s = unsafe_of_substring s (ofs + buf_left) (len - buf_left) in\n      add_nonempty_to_forest b.forest s\n    );\n    b.length <- b.length + len\n\n  let add_substring b s ofs len =\n    if ofs < 0 || len < 0 || ofs > String.length s - len then\n      invalid_arg \"Rope.Buffer.add_substring\";\n    unsafe_add_substring b s ofs len\n\n  let add_string b s = unsafe_add_substring b s 0 (String.length s)\n\n  let add_rope b (r: rope) =\n    if is_not_empty r then (\n      let len = length r in\n      if b.length > max_int - len then failwith \"Rope.Buffer.add_rope: \\\n\tbuffer length will exceed the int range\";\n      (* First add the part hold by [buf]: *)\n      add_to_forest b.forest (Sub(Bytes.sub_string b.buf 0 b.pos, 0, b.pos));\n      b.pos <- 0;\n      (* I thought [balance_insert b.forest r] was going to rebalance\n         [r] taking into account the content already in the buffer but\n         it does not seem faster.  We take the decision to possibly\n         rebalance when the content is asked. *)\n      add_nonempty_to_forest b.forest r; (* [r] not empty *)\n      b.length <- b.length + len\n    )\n  ;;\n\n  let add_buffer b b2 =\n    if b.length > max_int - b2.length then failwith \"Rope.Buffer.add_buffer: \\\n\tbuffer length will exceed the int range\";\n    add_to_forest b.forest (Sub(Bytes.sub_string b.buf 0 b.pos, 0, b.pos));\n    b.pos <- 0;\n    let forest = b.forest in\n    let forest2 = b2.forest in\n    for i = Array.length b2.forest - 1 to 0 do\n      add_to_forest forest forest2.(i)\n    done;\n    b.length <- b.length + b2.length\n  ;;\n\n  let add_channel b ic len =\n    if b.length > max_int - len then failwith \"Rope.Buffer.add_channel: \\\n\tbuffer length will exceed the int range\";\n    let buf_left = b.buf_len - b.pos in\n    if len <= buf_left then (\n      (* Enough space in [buf] to hold the input from the channel. *)\n      really_input ic b.buf b.pos len;\n      b.pos <- b.pos + len;\n    )\n    else (\n      (* [len > buf_left]. Complete [buf] and add it to the forest: *)\n      really_input ic b.buf b.pos buf_left;\n      add_nonempty_to_forest\n        b.forest (Sub(Bytes.unsafe_to_string b.buf, 0, b.buf_len));\n      (* Read the remaining from the channel *)\n      let len = ref(len - buf_left) in\n      while !len >= b.buf_len do\n        let s = Bytes.create b.buf_len in\n        really_input ic s 0 b.buf_len;\n        add_nonempty_to_forest\n          b.forest (Sub(Bytes.unsafe_to_string s, 0, b.buf_len));\n        len := !len - b.buf_len;\n      done;\n      (* [!len < b.buf_len] to read, put them into a new [buf]: *)\n      let s = Bytes.create b.buf_len in\n      really_input ic s 0 !len;\n      b.buf <- s;\n      b.pos <- !len;\n    );\n    b.length <- b.length + len\n  ;;\n\n  (* Search for the nth element in [forest.(i ..)] of total length [len] *)\n  let rec nth_forest forest k i len =\n    assert(k <= Array.length forest);\n    let r = forest.(k) in (* possibly empty *)\n    let ofs = len - length r in (* offset of [r] in the full rope *)\n    if i >= ofs then get r (i - ofs)\n    else nth_forest forest (k + 1) i ofs\n\n  let nth b i =\n    if i < 0 || i >= b.length then raise(Out_of_bounds \"Rope.Buffer.nth\");\n    let forest_len = b.length - b.pos in\n    if i >= forest_len then Bytes.get b.buf (i - forest_len)\n    else nth_forest b.forest 0 i forest_len\n  ;;\n\n  (* Return a rope, [buf] must be duplicated as it becomes part of the\n     rope, thus we duplicate it as ropes are immutable.  What we do is\n     very close to [add_nonempty_to_forest] followed by\n     [concat_forest] except that we do not modify the forest and we\n     select a sub-rope.  Assume [len > 0] -- and [i0 >= 0]. *)\n  let unsafe_sub (b: t) i0 len =\n    let i1 = i0 + len in (* 1 char past subrope *)\n    let forest_len = b.length - b.pos in\n    let buf_i1 = i1 - forest_len in\n    if buf_i1 >= len then\n      (* The subrope is entirely in [buf] *)\n      Sub(Bytes.sub_string b.buf (i0 - forest_len) len, 0, len)\n    else begin\n      let n = ref 0 in\n      let sum = ref empty in\n      if buf_i1 > 0 then (\n        (* At least one char in [buf] and at least one in the forest.\n           Concat the ropes of inferior length and append the part of [buf] *)\n        let rem_len = len - buf_i1 in\n        while buf_i1 > min_length.(!n + 1) && length !sum < rem_len do\n          sum := balance_concat b.forest.(!n) !sum;\n          if !n = level_flatten then sum := flatten !sum;\n          incr n\n        done;\n        sum := balance_concat\n                 !sum (Sub(Bytes.sub_string b.buf 0 buf_i1, 0, buf_i1))\n      )\n      else (\n        (* Subrope in the forest.  Skip the forest elements until\n           the last chunk of the sub-rope is found.  Since [0 < len\n           <= forest_len], there exists a nonempty rope in the forest. *)\n        let j = ref buf_i1 in (* <= 0 *)\n        while !j <= 0 do j := !j + length b.forest.(!n); incr n done;\n        sum := sub b.forest.(!n - 1) 0 !j (* init. with proper subrope *)\n      );\n      (* Add more forest elements until we get at least the desired length *)\n      while length !sum < len do\n        assert(!n < max_height);\n        sum := balance_concat b.forest.(!n) !sum;\n(* FIXME: Check how this line may generate a 1Mb leaf: *)\n(*         if !n = level_flatten then sum := flatten !sum; *)\n        incr n\n      done;\n      let extra = length !sum - len in\n      if extra = 0 then !sum else sub !sum extra len\n    end\n\n  let sub b i len =\n    if i < 0 || len < 0 || i > b.length - len then\n      invalid_arg \"Rope.Buffer.sub\";\n    if len = 0 then empty\n    else (unsafe_sub b i len)\n\n  let contents b =\n    if b.length = 0 then empty\n    else (unsafe_sub b 0 b.length)\n\n\n  let length b = b.length\nend\n\n\n(* Using the Buffer module should be more efficient than sucessive\n   concatenations and ensures that the final rope is balanced. *)\nlet concat sep = function\n  | [] -> empty\n  | r0 :: tl ->\n      let b = Buffer.create 1 in (* [buf] will not be used as we add ropes *)\n      Buffer.add_rope b r0;\n      List.iter (fun r -> Buffer.add_rope b sep; Buffer.add_rope b r) tl;\n      Buffer.contents b\n\n\n(* Modified *)\n\n(** Input/output -- modeled on Pervasive\n ***********************************************************************)\n\n(* Imported from pervasives.ml: *)\nlet rec output_string fh = function\n  | Sub(s, i0, len) -> output fh (Bytes.unsafe_of_string s) i0 len\n  | Concat(_, _, l,_, r) -> output_string fh l; output_string fh r\n;;\n\nlet output_rope = output_string\n\nlet print_string rope = output_string stdout rope\nlet print_endline rope = output_string stdout rope; print_newline()\n\nlet prerr_string rope = output_string stderr rope\nlet prerr_endline rope = output_string stderr rope; prerr_newline()\n\n\n(**/**)\nlet rec number_leaves = function\n  | Sub(_,_,_) -> 1\n  | Concat(_,_, l,_, r) -> number_leaves l + number_leaves r\n\nlet rec number_concat = function\n  | Sub(_,_,_) -> 0\n  | Concat(_,_, l,_, r) -> 1 + number_concat l + number_concat r\n\nlet rec length_leaves = function\n  | Sub(_,_, len) -> (len, len)\n  | Concat(_,_, l,_, r) ->\n      let (min1,max1) = length_leaves l\n      and (min2,max2) = length_leaves r in\n      (min min1 min2, max max1 max2)\n\n\nmodule IMap = Map.Make(struct\n  type t = int\n  let compare = Pervasives.compare\nend)\n\nlet distrib_leaves =\n  let rec add_leaves m = function\n    | Sub(_,_,len) ->\n        (try incr(IMap.find len !m)\n          with _ -> m := IMap.add len (ref 1) !m)\n    | Concat(_,_, l,_, r) -> add_leaves m l; add_leaves m r in\n  fun r ->\n    let m = ref(IMap.empty) in\n    add_leaves m r;\n    !m\n\n\n(**/**)\n\n(** Toplevel\n ***********************************************************************)\n\nmodule Rope_toploop = struct\n  open Format\n\n  let max_display_length = ref 400\n    (* When displaying, truncate strings that are longer than this. *)\n\n  let ellipsis = ref \"...\"\n    (* ellipsis for ropes longer than max_display_length.  User changeable.  *)\n\n  (* Return [max_len - length r].  *)\n  let rec printer_lim max_len (fm:formatter) r =\n    if max_len > 0 then\n      match r with\n      | Concat(_,_, l,_, r) ->\n          let to_be_printed = printer_lim max_len fm l in\n          printer_lim to_be_printed fm r\n      | Sub(s, i0, len) ->\n          let l = if len < max_len then len else max_len in\n          (match escaped_sub s i0 l with\n           | Sub (s, i0, len) ->\n              if i0 = 0 && len = String.length s then pp_print_string fm s\n              else for i = i0 to i0 + len - 1 do\n                     pp_print_char fm (String.unsafe_get s i)\n                   done\n           | Concat _ -> assert false);\n          max_len - len\n    else max_len\n\n  let printer fm r =\n    pp_print_string fm \"\\\"\";\n    let to_be_printed = printer_lim !max_display_length fm r in\n    pp_print_string fm \"\\\"\";\n    if to_be_printed < 0 then pp_print_string fm !ellipsis\nend\n\n(** Regexp\n ***********************************************************************)\n\nmodule Regexp = struct\n  (* FIXME: See also http://www.pps.jussieu.fr/~vouillon/ who is\n     writing a DFA-based regular expression library.  Would be nice to\n     cooperate. *)\n\nend\n\n\n;;\n(* Local Variables: *)\n(* compile-command: \"make -k -C..\" *)\n(* End: *)\n"
  },
  {
    "path": "src/cross-platform/wrapBn.ml",
    "content": "#if BSB_BACKEND = \"js\" then\n  type t = Bn.t\n  let to_string_in_hexa = Bn.toString ~base:16\n  let string_of_big_int = Bn.toString ~base:10\n  let big_int_of_string = Bn.fromString ~base:10\n  let hex_to_big_int h = Bn.fromString ~base:16 h\n  let eq_big_int = Bn.eq\n  let big_int_of_int x = x |> float_of_int |> Bn.fromFloat\n  let zero_big_int = Bn.fromFloat 0.\n  let unit_big_int = Bn.fromFloat 1.\n  let sub_big_int a b = Bn.sub b a\n#else\n  include WrapBnNative\n#end\n"
  },
  {
    "path": "src/cross-platform/wrapBnNative.ml",
    "content": "  type t = Big_int.big_int\n  let to_string_in_hexa = BatBig_int.to_string_in_hexa\n  let string_of_big_int = Big_int.string_of_big_int\n  let big_int_of_string = Big_int.big_int_of_string\n  let hex_to_big_int h = Big_int.big_int_of_string (\"0x\"^h)\n  let eq_big_int = Big_int.eq_big_int\n  let big_int_of_int = Big_int.big_int_of_int\n  let zero_big_int = Big_int.zero_big_int\n  let unit_big_int = Big_int.unit_big_int\n  let sub_big_int = Big_int.sub_big_int\n"
  },
  {
    "path": "src/cross-platform/wrapCryptokit.ml",
    "content": "#if BSB_BACKEND = \"js\" then\n  (* TODO: Create keccak BuckleScript bindings as a separate module *)\n  type keccakInit\n  type keccakUpdated\n  type keccakDigested\n  (* Copied from https://github.com/ethereum/web3.js/blob/3547be3d1f274f70074b9eb69c3324228fc50ea5/lib/utils/utils.js#L128-L141 *)\n  (* It can be imported after we have BuckleScript bindings to web3.js *)\n  let toAscii: string -> string = [%raw\n  {|\n    function(hex) {\n      // Find termination\n    var str = \"\";\n    var i = 0, l = hex.length;\n    if (hex.substring(0, 2) === '0x') {\n        i = 2;\n    }\n    for (; i < l; i+=2) {\n        var code = parseInt(hex.substr(i, 2), 16);\n        str += String.fromCharCode(code);\n    }\n    return str;\n    }\n  |}]\n  external create_keccak_hash : string -> keccakInit = \"keccak\"[@@bs.module ]\n  external update : string -> keccakUpdated = \"\"[@@bs.send.pipe :keccakInit]\n  external digest : string -> string = \"\"[@@bs.send.pipe :keccakUpdated]\n  let string_keccak str =\n    create_keccak_hash \"keccak256\" |> update str |> digest \"hex\"\n  let hex_keccak str =\n    create_keccak_hash \"keccak256\" |> update (toAscii str) |> digest \"hex\"\n#else\n  include WrapCryptokitNative\n#end\n"
  },
  {
    "path": "src/cross-platform/wrapCryptokitNative.ml",
    "content": "  module Hash = Cryptokit.Hash\n  let string_keccak str : string =\n    let sha3_256 = Hash.keccak 256 in\n    let () = sha3_256#add_string str in\n    let ret = sha3_256#result in\n    let tr = Cryptokit.Hexa.encode () in\n    let () = tr#put_string ret in\n    let () = tr#finish in\n    let ret = tr#get_string in\n    (* need to convert ret into hex *)\n    ret\n\n  let strip_0x h =\n    if BatString.starts_with h \"0x\" then\n      BatString.tail h 2\n    else\n      h\n  \n  let add_hex sha3_256 h =\n    let h = strip_0x h in\n    let add_byte c =\n      sha3_256#add_char c in\n    let chars = BatString.explode h in\n    let rec work chars =\n      match chars with\n      | [] -> ()\n      | [x] -> failwith \"odd-length hex\"\n      | a :: b :: rest ->\n        let () = add_byte (Hex.to_char a b) in\n        work rest in\n    work chars\n  \n  let hex_keccak h : string =\n    let sha3_256 = Hash.keccak 256 in\n    let () = add_hex sha3_256 h in\n    let ret = sha3_256#result in\n    let tr = Cryptokit.Hexa.encode () in\n    let () = tr#put_string ret in\n    let () = tr#finish in\n    let ret = tr#get_string in\n    (* need to convert ret into hex *)\n    ret\n"
  },
  {
    "path": "src/cross-platform/wrapList.ml",
    "content": "#if BSB_BACKEND = \"js\" then\n  let range i j =\n    let rec aux n acc = if n < i then acc else aux (n - 1) (n :: acc) in\n    aux j []\n  let sum l =\n    let rec s rest acc = match rest with | [] -> acc | h::t -> s t (acc + h) in\n    s l 0\n  let filter_map f l =\n    let maybeAddHead filter head list =\n      match filter head with\n      | ((Some (v))[@explicit_arity ]) -> v :: list\n      | None  -> list in\n    let rec s rest acc =\n      match rest with | [] -> List.rev acc | h::t -> s t (maybeAddHead f h acc) in\n    s l []\n  let rec last = function\n    | [] -> invalid_arg \"Empty List\"\n    | x::[] -> x\n    | _::t -> last t\n\n  (* Copied from *)\n  type 'a mut_list = {\n    hd: 'a;\n    mutable tl: 'a list;}\n  external inj : 'a mut_list -> 'a list = \"%identity\"\n  module Acc =\n    struct\n      let dummy () = { hd = (Obj.magic ()); tl = [] }\n      let create x = { hd = x; tl = [] }\n      let accum acc x = let cell = create x in acc.tl <- inj cell; cell\n    end\n  let unique ?(eq= (=))  l =\n    let rec loop dst =\n      function\n      | [] -> ()\n      | h::t ->\n          (match List.exists (eq h) t with\n          | true  -> loop dst t\n          | false  -> loop (Acc.accum dst h) t) in\n    let dummy = Acc.dummy () in loop dummy l; dummy.tl;;\n#else\n  include WrapListNative\n#end\n"
  },
  {
    "path": "src/cross-platform/wrapListNative.ml",
    "content": "  let range i j = BatList.(range i `To j)\n  let sum = BatList.sum\n  let filter_map = BatList.filter_map\n  let last = BatList.last\n  let unique = BatList.unique\n"
  },
  {
    "path": "src/cross-platform/wrapOption.ml",
    "content": "#if BSB_BACKEND = \"js\" then\n  include Js.Option\n  (* Js.Option.map expects the callback to be uncurried\n  https://bucklescript.github.io/bucklescript/api/Js.Option.html#VALmap\n  Explanation: https://bucklescript.github.io/docs/en/function.html#curry-uncurry *)\n  let map a = Js.Option.map ((fun x  -> a x)[@bs])\n#else\n  include BatOption\n#end"
  },
  {
    "path": "src/cross-platform/wrapString.ml",
    "content": "#if BSB_BACKEND = \"js\" then\n  let starts_with = Js.String.startsWith\n#else\n  include WrapStringNative\n#end\n"
  },
  {
    "path": "src/cross-platform/wrapStringNative.ml",
    "content": "  let starts_with = BatString.starts_with\n"
  },
  {
    "path": "src/cross-platform-for-ocamlbuild/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: ee11ff5ab0dcdc3283bfdeea5feb58b8)\nversion = \"0.0.03\"\ndescription = \"A compiler targeting Ethereum Virtual Machine\"\nrequires = \"batteries rope cryptokit hex\"\narchive(byte) = \"cross-platform.cma\"\narchive(byte, plugin) = \"cross-platform.cma\"\narchive(native) = \"cross-platform.cmxa\"\narchive(native, plugin) = \"cross-platform.cmxs\"\nexists_if = \"cross-platform.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/cross-platform-for-ocamlbuild/cross-platform.mldylib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 5f3e3f97fec314fba146c24e67ee5ea3)\nWrapBn\nWrapCryptokit\nWrapList\nWrapString\nWrapOption\n# OASIS_STOP\n"
  },
  {
    "path": "src/cross-platform-for-ocamlbuild/cross-platform.mllib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 5f3e3f97fec314fba146c24e67ee5ea3)\nWrapBn\nWrapCryptokit\nWrapList\nWrapString\nWrapOption\n# OASIS_STOP\n"
  },
  {
    "path": "src/cross-platform-for-ocamlbuild/wrapOption.ml",
    "content": "include BatOption\n"
  },
  {
    "path": "src/exec/bamboo.ml",
    "content": "open Lexer\nopen Lexing\nopen Printf\nopen Syntax\nopen Codegen\n\n(* The following two functions comes from\n * https://github.com/realworldocaml/examples/tree/master/code/parsing-test\n * which is under UNLICENSE\n *)\nlet print_position outx lexbuf =\n  let pos = lexbuf.lex_curr_p in\n  fprintf outx \"%s:%d:%d\" pos.pos_fname\n    pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)\n\nlet parse_with_error lexbuf =\n  try Parser.file Lexer.read lexbuf with\n  | SyntaxError msg ->\n    fprintf stderr \"%a: %s\\n\" print_position lexbuf msg;\n    exit (-1)\n  | Parser.Error ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n  | _ ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n\nlet abi_option = BatOptParse.StdOpt.store_true ()\n\nlet optparser : BatOptParse.OptParser.t = BatOptParse.OptParser.make ~version:\"0.0.03\" ~usage:\"bamboo [options] < src.bbo\" ~description:\"By default, bamboo compiles the source from stdin and prints EVM bytecode in stdout.  Do not trust the output as the compiler still contains bugs probably.\" ()\n\nlet () =\n  let () = BatOptParse.OptParser.add optparser ~long_names:[\"abi\"] ~help:\"print the ABI interface in JSON\" abi_option in\n  let files = BatOptParse.OptParser.parse_argv optparser in\n  let () =\n    if files <> [] then\n      (Printf.eprintf \"This compiler accepts input from stdin.\\n\";\n       exit 1)\n  in\n\n  let abi : bool = (Some true = abi_option.BatOptParse.Opt.option_get ()) in\n\n  let lexbuf = Lexing.from_channel stdin in\n  let toplevels : unit Syntax.toplevel list = parse_with_error lexbuf in\n  let toplevels = Assoc.list_to_contract_id_assoc toplevels in\n  let toplevels : Syntax.typ Syntax.toplevel Assoc.contract_id_assoc = Type.assign_types toplevels in\n  let contracts = Assoc.filter_map (fun x ->\n                      match x with\n                      | Contract c -> Some c\n                      | _ -> None) toplevels in\n  let () = match contracts with\n  | [] -> ()\n  | _ ->\n     let constructors : constructor_compiled Assoc.contract_id_assoc = compile_constructors contracts in\n     let contracts_layout_info : (Assoc.contract_id * LayoutInfo.contract_layout_info) list =\n       List.map (fun (id, const) -> (id, layout_info_from_constructor_compiled const)) constructors in\n     let layout = LayoutInfo.construct_layout_info contracts_layout_info in\n     let runtime_compiled = compile_runtime layout contracts in\n     let bytecode : WrapBn.t Evm.program =\n       compose_bytecode constructors runtime_compiled (fst (List.hd contracts)) in\n     let () =\n       if abi then\n         Ethereum.print_abi toplevels\n       else\n         Evm.print_imm_program bytecode\n     in\n     () in\n  ()\n"
  },
  {
    "path": "src/exec/compileFile.ml",
    "content": "open Codegen\n\nlet compile_file (file : string) : string =\n  BatFile.with_file_in\n    file\n    (fun channel ->\n      let lexbuf = BatLexing.from_input channel in\n      let contracts : unit Syntax.toplevel list = Parse.parse_with_error lexbuf in\n      let contracts = Assoc.list_to_contract_id_assoc contracts in\n      let contracts : Syntax.typ Syntax.toplevel Assoc.contract_id_assoc = Type.assign_types contracts in\n      let contracts = Assoc.filter_map (fun x -> match x with Syntax.Contract c -> Some c | _ -> None) contracts in\n      let constructors : constructor_compiled Assoc.contract_id_assoc = compile_constructors contracts in\n      let contracts_layout_info : (Assoc.contract_id * LayoutInfo.contract_layout_info) list =\n        List.map (fun (id, const) -> (id, layout_info_from_constructor_compiled const)) constructors in\n      let layout = LayoutInfo.construct_layout_info contracts_layout_info in\n      let runtime_compiled = compile_runtime layout contracts in\n      let bytecode = compose_bytecode constructors runtime_compiled (fst (List.hd contracts)) in\n      Evm.string_of_imm_program bytecode)\n"
  },
  {
    "path": "src/exec/compileFile.mli",
    "content": "(** [compile_file filename] compiles the source of filename into a constructor bytecode *)\nval compile_file : string -> string\n"
  },
  {
    "path": "src/exec/endToEnd.ml",
    "content": "(* below is largely based on ocaml-rpc *)\n\n(*\n * Copyright (c) 2006-2009 Citrix Systems Inc.\n * Copyright (c) 2006-2014 Thomas Gazagnaire <thomas@gazagnaire.org>\n *\n * Permission to use, copy, modify, and distribute this software for any\n * purpose with or without fee is hereby granted, provided that the above\n * copyright notice and this permission notice appear in all copies.\n *\n * THE SOFTWARE IS PROVIDED \"AS IS\" AND THE AUTHOR DISCLAIMS ALL WARRANTIES\n * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF\n * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR\n * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES\n * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN\n * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF\n * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.\n*)\n\n(* Yoichi Hirai: I modified the above-mentinoed code. *)\n\n\nexception Connection_reset\n\nlet lib_version = \"0.1.1\"\n\nmodule Utils = struct\n\n  let open_connection_unix_fd filename =\n    let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in\n    try\n      let addr = Unix.ADDR_UNIX(filename) in\n      Unix.connect s addr;\n      Printf.eprintf \"connected \\n%!\";\n      s\n    with e ->\n      Printf.eprintf \"some problem \\n%!\";\n      Unix.close s;\n      raise e\n\n  let minisleep (sec: float) =\n    ignore (Unix.select [] [] [] sec)\nend\n\ntype connection =\n  | Unix_socket of string\n\nlet string_of_call ?(version=Jsonrpc.V1) (call : Rpc.call) =\n  let c = call in\n  Rpc.(Jsonrpc.\n  (let json =\n    match version with\n    | V1 ->\n      Dict [\n        \"method\", String ((c : Rpc.call).name);\n        \"params\", Enum c.params;\n        \"id\", Int (new_id ());\n      ]\n    | V2 ->\n      Dict [\n        \"jsonrpc\", String \"2.0\";\n        \"method\", String c.name;\n        \"params\", Rpc.Enum c.params;\n        \"id\", Int (new_id ());\n      ]\n  in\n  to_string json))\n\nlet string_of_rpc_call (call : Rpc.call) =\n  string_of_call ~version:(Jsonrpc.V2) call\n\nlet rpc_response_of_fd fd =\n  Jsonrpc.response_of_in_channel (Unix.in_channel_of_descr fd)\n\nlet send_call ~fd call =\n  let body = string_of_rpc_call call in\n  let output_string str =\n    ignore (Unix.write fd (Bytes.of_string str) 0 (String.length str)) in\n  output_string body\n\nlet rpc_fd (fd: Unix.file_descr) call =\n  try\n    send_call ~fd call;\n    rpc_response_of_fd fd\n  with Unix.Unix_error(Unix.ECONNRESET, _, _) ->\n    raise Connection_reset\n\nlet with_fd s ~call =\n  try\n    let result = rpc_fd s call in\n    result\n  with e ->\n    raise e\n\nlet do_rpc_unix s call =\n  with_fd s ~call\n\n\nlet eth_accounts_call : Rpc.call =\n  Rpc.({ name = \"eth_accounts\"\n       ; params = []\n       })\n\n(* How to perform a call and expect a return of eth_accounts *)\n\nlet filename = \"/tmp/test/geth.ipc\"\n\ntype address = string [@@deriving rpc]\n\ntype eth_accounts = address list [@@deriving rpc]\n\ntype eth_transaction =\n  { from : string\n  ; _to : string [@key \"to\"]\n  ; gas : string\n  ; value : string\n  ; data : string\n  ; gasprice : string\n  }\n  [@@deriving rpc]\n\nlet pick_result (j : Rpc.response) =\n  let j = Jsonrpc.json_of_response Jsonrpc.V2 j in\n  Rpc.\n  (match j with\n  | Dict x ->\n     begin\n       try\n         List.assoc \"result\" x\n       with Not_found ->\n         let () = Printf.eprintf \"got response %s\\n%!\" (Rpc.string_of_rpc j) in\n         raise Not_found\n     end\n  | _ ->\n     failwith \"unexpected form\"\n  )\n\nlet eth_accounts s : eth_accounts =\n  let res : Rpc.response = (do_rpc_unix s eth_accounts_call) in\n  let json : Rpc.t = pick_result res in\n  let result : eth_accounts = eth_accounts_of_rpc json in\n  result\n\nlet init_code_dummy = \"0x00\"\n\nlet eth_sendTransaction s (trans : eth_transaction) : address =\n  let call : Rpc.call =\n    Rpc.({ name = \"eth_sendTransaction\"\n         ; params = [rpc_of_eth_transaction trans]\n         }) in\n  let res : Rpc.response = do_rpc_unix s call in\n  let json : Rpc.t = pick_result res in\n  let result = address_of_rpc json in\n  result\n\nlet eth_call s (trans : eth_transaction) : string =\n  let c : Rpc.call =\n    Rpc.({ name = \"eth_call\"\n         ; params = [rpc_of_eth_transaction trans; Rpc.rpc_of_string \"latest\"]\n         }) in\n  let res : Rpc.response = do_rpc_unix s c in\n  let json = pick_result res in\n  Rpc.string_of_rpc json\n\nlet test_mineBlocks s (num : int) =\n  let call : Rpc.call =\n    Rpc.({ name = \"test_mineBlocks\"\n         ; params = [Rpc.Int (Int64.of_int num)]\n         }) in\n  let ()  = ignore (pick_result (do_rpc_unix s call)) in\n  ()\n\nlet test_rawSign s (addr : address) (data : string) =\n  let call : Rpc.call =\n    Rpc.({ name = \"test_rawSign\"\n         ; params = [rpc_of_address addr; rpc_of_string data]\n         }) in\n  let res = do_rpc_unix s call in\n  let json = pick_result res in\n  Rpc.string_of_rpc json\n\n\nlet eth_getBalance s (addr : address) : WrapBn.t =\n  let call : Rpc.call =\n    Rpc.({ name = \"eth_getBalance\"\n         ; params = [rpc_of_address addr; Rpc.rpc_of_string \"latest\"]\n         }) in\n  let res : Rpc.response = do_rpc_unix s call in\n  let json = pick_result res in\n  let () = Printf.printf \"got result %s\\n%!\" (Rpc.string_of_rpc json) in\n  let result = Rpc.string_of_rpc json in\n  Big_int.big_int_of_string result\n\nlet test_setChainParams s (config : Rpc.t) : unit =\n  let call : Rpc.call =\n    Rpc.({ name = \"test_setChainParams\"\n         ; params = [config]\n         }) in\n  ignore (do_rpc_unix s call)\n\nlet rich_config (accounts : address list) : Rpc.t =\n  let accounts_with_balance =\n    List.map (fun addr ->\n        (addr, Rpc.(Dict [ (\"wei\", String \"0x100000000000000000000000000000000000000000\") ]))) accounts in\n  Rpc.(Dict\n         [ (\"sealEngine\", String \"NoProof\")\n\t\t ; (\"params\", Dict\n                        [ (\"accountStartNonce\", String \"0x\")\n                        ; (\"maximumExtraDataSize\", String \"0x1000000\")\n                        ; (\"blockReward\", String \"0x\")\n                        ; (\"allowFutureBlocks\", String \"1\")\n\t\t\t            ; (\"homesteadForkBlock\", String \"0x00\")\n\t\t\t            ; (\"EIP150ForkBlock\", String \"0x00\")\n\t\t\t            ; (\"EIP158ForkBlock\", String \"0x00\")\n                        ; (\"constantinopleForkBlock\", String \"0xffffffffffffffffffff\")\n           ])\n\t\t ; (\"genesis\", Dict\n                         [ (\"author\", String \"0000000000000010000000000000000000000000\")\n\t\t\t             ; (\"timestamp\", String \"0x00\")\n\t\t\t             ; (\"parentHash\", String \"0x0000000000000000000000000000000000000000000000000000000000000000\")\n\t\t\t             ; (\"extraData\", String \"0x\")\n\t\t\t             ; (\"gasLimit\", String \"0x1000000000000\")\n           ])\n         ;  (\"accounts\", Dict accounts_with_balance)\n         ]\n  )\n\ntype log =\n  { topics : string list\n  } [@@ deriving rpc]\n\ntype transaction_receipt =\n  { blockHash : string\n  ; blockNumber : int64\n  ; transactionHash : string\n  ; transactionIndex : int64\n  ; cumulativeGasUsed : int64\n  ; gasUsed : int64\n  ; contractAddress : address\n  ; logs : log list\n  } [@@ deriving rpc]\n\nlet eth_getTransactionReceipt s (tx : string) : transaction_receipt =\n  let call : Rpc.call =\n    { Rpc.name = \"eth_getTransactionReceipt\"\n    ; Rpc.params = [Rpc.rpc_of_string tx]\n    } in\n  let res : Rpc.response = do_rpc_unix s call in\n  let json : Rpc.t =\n    pick_result res\n  in\n  let result = transaction_receipt_of_rpc json in\n  result\n\nlet eth_blockNumber s : int64 =\n  let call : Rpc.call =\n    Rpc.({ name = \"eth_blockNumber\"\n         ; params = []\n         }) in\n  let res : Rpc.response = do_rpc_unix s call in\n  let json = pick_result res in\n  let result = Rpc.int64_of_rpc json in\n  result\n\nlet eth_getCode s addr : string =\n  let call : Rpc.call =\n    Rpc.({ name = \"eth_getCode\"\n         ; params = [rpc_of_address addr; rpc_of_string \"latest\"]\n         }) in\n  let res : Rpc.response = do_rpc_unix s call in\n  let json = pick_result res in\n  let result = Rpc.string_of_rpc json in\n  result\n\nlet test_rewindToBlock s =\n  let call = Rpc.({ name = \"test_rewindToBlock\"\n                  ; params = [Rpc.Int (Int64.of_int 0)]\n                  }) in\n  ignore (do_rpc_unix s call)\n\nlet personal_newAccount s =\n  let call = Rpc.({ name = \"personal_newAccount\"\n                  ; params = [rpc_of_string \"\"]\n                  }) in\n  let ret = do_rpc_unix s call in\n  let json = pick_result ret in\n  address_of_rpc json\n\nlet personal_unlockAccount s addr =\n  let call = Rpc.({ name = \"personal_unlockAccount\"\n                  ; params = [rpc_of_address addr; rpc_of_string \"\"; rpc_of_int 100000]\n                  }) in\n  ignore (do_rpc_unix s call)\n\nlet eth_getStorageAt s addr slot =\n  let call = Rpc.({ name = \"eth_getStorageAt\"\n                  ; params = [rpc_of_address addr; rpc_of_string (WrapBn.string_of_big_int slot); rpc_of_string \"latest\"]\n             }) in\n  let ret = do_rpc_unix s call in\n  let json = pick_result ret in\n  Big_int.big_int_of_string (Rpc.string_of_rpc json)\n\nlet wait_till_mined s old_block =\n  while eth_blockNumber s = old_block do\n    Utils.minisleep 0.01\n  done\n\nlet sample_file_name : string = \"./src/parse/examples/006auction_first_case.bbo\"\n\nlet advance_block s =\n  let old_blk = eth_blockNumber s in\n  let () = test_mineBlocks s 1 in\n  let () = wait_till_mined s old_blk in\n  ()\n\nlet reset_chain s acc =\n  (* Maybe it's not necessary to create a new account every time *)\n  let my_acc =\n    match acc with\n    | None ->\n       personal_newAccount s\n    | Some acc -> acc in\n  let config = rich_config [my_acc] in\n  let () = test_setChainParams s config in\n  let () = test_rewindToBlock s in\n  let () = test_rewindToBlock s in\n  let balance = eth_getBalance s my_acc in\n  let () = assert (Big_int.gt_big_int balance (Big_int.big_int_of_int 10000000000000000)) in\n  my_acc\n\nlet deploy_code s my_acc code value =\n  let trans : eth_transaction =\n    { from = my_acc\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = value\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    ; data = code\n    ; _to = \"0x\"\n    }\n  in\n  let tx = (eth_sendTransaction s trans) in\n  let () = advance_block s in\n  let receipt = eth_getTransactionReceipt s tx in\n  receipt\n\nlet call s tr =\n  let tx = eth_sendTransaction s tr in\n  let () = advance_block s in\n  eth_getTransactionReceipt s tx\n\nlet testing_006 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file sample_file_name in\n  let initcode_args : string =\n    \"0000000000000000000000000000000000000000000000000000000000000000\"\n    ^ \"0000000000000000000000000000000000000000000000000000000400000020\"\n    ^ \"0000000000000000000000000000000000000000000000000000000000000000\" in\n  let initcode = initcode_compiled^initcode_args in\n  let receipt = deploy_code s my_acc initcode \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let original = eth_getStorageAt s contract_address (Big_int.big_int_of_int 4) in\n  let () = assert (Big_int.(eq_big_int original zero_big_int)) in\n  let tr : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"100\"\n    ; data = \"\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call s tr in\n  let n = eth_getStorageAt s contract_address (Big_int.big_int_of_int 4) in\n  let () = Printf.printf \"got storage %s\\n\" (WrapBn.string_of_big_int n) in\n  let () = assert (Big_int.(eq_big_int n (big_int_of_int 100))) in\n  ()\n\nlet constructor_arg_test s =\n  let initcode_compiled : string = CompileFile.compile_file sample_file_name in\n  let initcode_args : string =\n    \"0000000000000000000000000000000000000000000000000000000000000000\"\n    ^ \"0000000000000000000000000000000000000000000000000000000000000000\" in\n  let initcode = initcode_compiled^initcode_args in\n  let my_acc = reset_chain s None in\n  let receipt = deploy_code s my_acc initcode \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (not (String.length deployed > 2)) in\n  let () = Printf.printf \"didn't find code! good!\\n\" in\n  my_acc\n\nlet testing_00bb s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00bbauction_first_named_case.bbo\" in\n  let initcode_args : string =\n    \"0000000000000000000000000000000000000000000000000000000000000000\" in\n  let initcode = initcode_compiled^initcode_args in\n  let receipt = deploy_code s my_acc initcode \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code! %s\\n\" deployed in\n  let storage_first_word = eth_getStorageAt s contract_address (Big_int.big_int_of_int 0) in\n  let () = Printf.printf \"first word! %s\\n\" (WrapBn.string_of_big_int storage_first_word) in\n  let original = eth_getStorageAt s contract_address (Big_int.big_int_of_int 4) in\n  let () = assert (Big_int.(eq_big_int original zero_big_int)) in\n  let tr : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"100\"\n    ; data = Ethereum.compute_signature_hash \"bid()\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call s tr in\n  let () = Printf.printf \"used gas: %s\\n%!\" (Int64.to_string receipt.gasUsed) in\n  let () = Printf.printf \"transaction hash: %s\\n%!\" receipt.transactionHash in\n  let n = eth_getStorageAt s contract_address (Big_int.big_int_of_int 2) in\n  let () = assert (Big_int.(eq_big_int n (big_int_of_int 100))) in\n  ()\n\n\n(* showing not quite satisfactory results *)\nlet testing_00b s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00b_auction_more.bbo\" in\n  let initcode_args : string =\n    \"0000000000000000000000000000000000000000000000000000000000000000\"\n    ^ \"ff00000000000000000000000000000000000000000000000000000400000020\"\n    ^ \"0000000000000000000000000000000000000000000000000000000000000000\" in\n  let initcode = initcode_compiled^initcode_args in\n  let receipt = deploy_code s my_acc initcode \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let highest_bid : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = Ethereum.compute_signature_hash \"highest_bid()\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s highest_bid in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let tr : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"100\"\n    ; data = Ethereum.compute_signature_hash \"bid()\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call s tr in\n  let answer = eth_call s highest_bid in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x0000000000000000000000000000000000000000000000000000000000000064\") in\n  ()\n\nlet testing_010 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/010_logical_and.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let both : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f(bool,bool)\") ^ \"0000000000000000000000000000000000000000000000000000000005f5e1000000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s both in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x0000000000000000000000000000000000000000000000000000000000000001\") in\n  ()\n\nlet testing_011 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/011_keccak256.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let both : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f(address,bytes32)\") ^ \"0000000000000000000000000000000000000000000000000000000005f5e1000000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s both in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let expectation = \"0x\" ^ (Ethereum.hex_keccak \"0x0000000000000000000000000000000005f5e1000000000000000000000000000000000000000000000000000000000005f5e100\") in\n  let () = Printf.printf \"expectation: %s\\n%!\" expectation in\n  let () = assert (answer = expectation) in\n  ()\n\nlet random_ecdsa s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00e_ecdsarecover.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert(String.length deployed > 2) in (* XXX the procedure so far can be factored out *)\n  let random_req : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = \"0x\" ^ (Ethereum.compute_signature_hash \"a(bytes32,uint8,bytes32,bytes32)\") ^\n        \"0000000000000000000000000000000000000000000000000000000005f5e100\"^\n               \"0000000000000000000000000000000000000000000000000000000005f5e100\"^\n                 \"0000000000000000000000000000000000000000000000000000000005f5e100\"^\n                   \"0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s random_req in\n  let () = Printf.printf \"got answer: %s\\n\" answer in\n  let tx = eth_sendTransaction s random_req in\n  let () = advance_block s in\n  let () = Printf.printf \"transaction id for random_eq: %s\\n%!\" tx in\n\n  let () = assert(answer = \"0x0000000000000000000000000000000000000000000000000000000000000000\") in\n  ()\n\n\nlet correct_ecdsa s my_acc =\n  (* The input data and the output data are cited from Parity:builtin.rs from commit\n   * 3308c404400a2bc58b12489814e9f3cfd5c9d272\n   *)\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00e_ecdsarecover.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert(String.length deployed > 2) in (* XXX the procedure so far can be factored out *)\n  let random_req : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = \"0x\" ^ (Ethereum.compute_signature_hash \"a(bytes32,uint8,bytes32,bytes32)\") ^\n        \"47173285a8d7341e5e972fc677286384f802f8ef42a5ec5f03bbfa254cb01fad000000000000000000000000000000000000000000000000000000000000001b650acf9d3f5f0a2c799776a1254355d5f4061762a237396a99a0e0e3fc2bcd6729514a0dacb2e623ac4abd157cb18163ff942280db4d5caad66ddf941ba12e03\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s random_req in\n  let () = Printf.printf \"got answer: %s\\n\" answer in\n  let tx = eth_sendTransaction s random_req in\n  let () = advance_block s in\n  let () = Printf.printf \"transaction id for random_eq: %s\\n%!\" tx in\n\n  let () = assert(answer = \"0x000000000000000000000000c08b5542d177ac6686946920409741463a15dddb\") in\n  ()\n\nlet zero_word = \"0000000000000000000000000000000000000000000000000000000000000000\"\nlet one_word =  \"0000000000000000000000000000000000000000000000000000000000000001\"\n\nlet testing_00i s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00i_local_bool.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f(uint8)\") ^ zero_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s c in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x\" ^ one_word) in\n  ()\n\nlet testing_013 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/013_iszero.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"a(bytes32)\") ^ zero_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s c in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x0000000000000000000000000000000000000000000000000000000000000001\") in\n  ()\n\nlet zero_word = \"0000000000000000000000000000000000000000000000000000000000000000\"\nlet one_word =  \"0000000000000000000000000000000000000000000000000000000000000001\"\n\nlet testing_022 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/022_plus_gt.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f(uint256,uint256,uint256)\") ^ one_word ^ one_word ^ zero_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s c in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x0000000000000000000000000000000000000000000000000000000000000000\") in\n  ()\n\nlet testing_014 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/014_ifelse.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f(bool,bool)\") ^ zero_word ^ one_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call s c in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x\" ^ zero_word) in\n  ()\n\nlet testing_016 s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/016_void.bbo\" in\n  let receipt = deploy_code s my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"300\"\n    ; data = (Ethereum.compute_signature_hash \"pass(address,uint256)\") ^ \"000000000000000000000000000000000000000000000000000000000000aaaa\" ^ \"0000000000000000000000000000000000000000000000000000000000000001\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let tx = eth_sendTransaction s c in\n  let () = advance_block s in\n  let balance = eth_getBalance s \"0x000000000000000000000000000000000000aaaa\" in\n  let () = assert (Big_int.(eq_big_int balance (big_int_of_int 1))) in\n  ()\n\nlet pad_to_word str =\n  let str = WrapCryptokit.strip_0x str in\n  let len = String.length str in\n  let () = assert (len <= 64) in\n  let padded = 64 - len in\n  let pad = BatString.make padded '0' in\n  pad ^ str\n\nlet testing_00h_timeout s my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00h_payment_channel.bbo\" in\n  let sender = pad_to_word (WrapCryptokit.strip_0x my_acc) in\n  let recipient = pad_to_word (WrapCryptokit.strip_0x my_acc) in\n  let startDate = \"0000000000000000000000000000000000000000000000000000000000010000\" in\n  let endDate   = \"0000000000000000000000000000000000000000000000000000000000020000\" in\n  let initdata = initcode_compiled ^\n                   sender ^\n                     recipient ^\n                       startDate ^\n                         endDate\n  in\n  let receipt = deploy_code s my_acc initdata \"300\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode s contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let balance = eth_getBalance s contract_address in\n  let () = assert (Big_int.(eq_big_int balance (big_int_of_int 300))) in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = Ethereum.compute_signature_hash \"ChannelTimeOut()\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call s c in\n  let () = Printf.printf \"timeout tx: %s\\n%!\" receipt.transactionHash in\n  let balance = eth_getBalance s contract_address in\n  let () = assert (Big_int.(eq_big_int balance zero_big_int)) in\n  ()\n\nlet testing_00h_early channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/00h_payment_channel.bbo\" in\n  let sender = pad_to_word (WrapCryptokit.strip_0x my_acc) in\n  let recv   = personal_newAccount channel in\n  let recipient = pad_to_word (WrapCryptokit.strip_0x recv) in\n\n  (* give receiver some Ether so that she can send transactions *)\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = recv\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"1000000000000000000000000\"\n    ; data = \"0x00\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let () = ignore (call channel c) in\n\n  let startDate = \"0000000000000000000000000000000000000000000000000000000000010000\" in\n  let endDate   = \"0000000000000000000000000000000000000100000000000000000000020000\" in\n  let initdata = initcode_compiled ^ sender ^ recipient ^ startDate ^ endDate in\n  let receipt = deploy_code channel my_acc initdata \"0x3000000000\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let balance = eth_getBalance channel contract_address in\n  let () = assert (Big_int.(eq_big_int balance (big_int_of_string \"0x3000000000\"))) in\n  let value = \"0000000000000000000000000000000000000000000000000000002000000000\" in\n  let concatenation = (WrapCryptokit.strip_0x contract_address) ^ value in\n  let () = Printf.printf \"concatenation: %s\\n\" concatenation in\n  let hash = Ethereum.hex_keccak concatenation in\n  let () = Printf.printf \"hash:          %s\\n\" hash in\n\n  (* first call *)\n  let sign = test_rawSign channel recv hash in\n  let () = Printf.printf \"sign:          %s\\n\" sign in\n  let sign = BatString.tail sign 2 in\n  let r = BatString.sub sign 0 64 in\n  let s = BatString.sub sign 64 64 in\n  let v = \"00000000000000000000000000000000000000000000000000000000000000\" ^ (BatString.sub sign 128 2) in\n  let () = Printf.printf \"v: %s\\n\" v in\n  let c : eth_transaction =\n    { from = recv\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = \"0x\" ^ Ethereum.compute_signature_hash \"CloseChannel(bytes32,uint8,bytes32,bytes32,uint256)\" ^\n               hash ^ v ^ r ^ s ^ value\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let () = Printf.printf \"sent data looks like this %s\\n\" c.data in\n  let () = assert (String.length c.data = (4 + 32 + 32 + 32 + 32 + 32) * 2  + 2) in\n  let receipt = call channel c in\n  let () = Printf.printf \"timeout tx: %s\\n%!\" receipt.transactionHash in\n\n  (* second call *)\n  let sign = test_rawSign channel my_acc hash in\n  let () = Printf.printf \"sign:          %s\\n\" sign in\n  let sign = BatString.tail sign 2 in\n  let r = BatString.sub sign 0 64 in\n  let s = BatString.sub sign 64 64 in\n  let v = \"00000000000000000000000000000000000000000000000000000000000000\" ^ (BatString.sub sign 128 2) in\n  let c : eth_transaction =\n    { from = recv\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = Ethereum.compute_signature_hash \"CloseChannel(bytes32,uint8,bytes32,bytes32,uint256)\" ^\n               hash ^ v ^ r ^ s ^ value\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call channel c in\n  let () = Printf.printf \"timeout tx: %s\\n%!\" receipt.transactionHash in\n\n  (* need to do a bit more *)\n  let balance = eth_getBalance channel contract_address in\n  let () = assert (Big_int.(eq_big_int balance zero_big_int)) in\n  let recv_balance = eth_getBalance channel recv in\n  let () = assert (Big_int.(gt_big_int recv_balance (big_int_of_string \"0x2000000000\"))) in\n  ()\n\n\nlet zero_word = \"0000000000000000000000000000000000000000000000000000000000000000\"\nlet one_word =  \"0000000000000000000000000000000000000000000000000000000000000001\"\n\nlet testing_mapmap_non_interference channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/018_mapmap.bbo\" in\n\n  let receipt = deploy_code channel my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n\n  let write_to_true : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"set(bool,address,bool)\")^\n               one_word ^ zero_word ^ one_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let receipt = call channel write_to_true in\n  let () = Printf.printf \"write tx: %s\\n\" receipt.transactionHash in\n\n  let read_from_true : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"get(bool,address)\") ^\n               one_word ^ zero_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call channel read_from_true in\n  let receipt = call channel read_from_true in\n  let () = Printf.printf \"read tx: %s\\n\" receipt.transactionHash in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x0000000000000000000000000000000000000000000000000000000000000001\") in\n\n  let read_from_false : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"get(bool,address)\") ^\n               zero_word ^ zero_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let answer = eth_call channel read_from_false in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x0000000000000000000000000000000000000000000000000000000000000000\") in\n\n  ()\n\nlet testing_019 channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/019_something.bbo\" in\n  let initdata = initcode_compiled ^ \"00000000000000000000000000000000000000000000000000005af3107a4000\" ^ (pad_to_word (WrapCryptokit.strip_0x my_acc)) in\n  let receipt = deploy_code channel my_acc initdata \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n\n  let initial_trans : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = \"0x\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call channel initial_trans in\n\n  let ask_my_balance : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"balanceOf(address)\")^(pad_to_word (WrapCryptokit.strip_0x my_acc))\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call channel ask_my_balance in\n  let () = assert (answer = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\") in\n  let () = Printf.printf \"balance match!\\n\" in\n  ()\n\n\nlet testing_land_neq channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/021_land_neq.bbo\" in\n  let receipt = deploy_code channel my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n\n  let initial_trans : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f()\")\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let answer = eth_call channel initial_trans in\n  let () = Printf.printf \"got answer %s\\n%!\" answer in\n  let () = assert (answer = \"0x\" ^ one_word) in\n  ()\n\n\nlet testing_01a channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/01a_event.bbo\" in\n\n  let receipt = deploy_code channel my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n\n  let write_to_true : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"e(uint256)\")^one_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let receipt = call channel write_to_true in\n  let () = assert (List.length receipt.logs = 1) in\n  let log = List.hd receipt.logs in\n  let () = assert (List.length log.topics = 2) in\n\n  ()\n\nlet test_plus_mult channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/020_plus_mult.bbo\" in\n\n  let receipt = deploy_code channel my_acc initcode_compiled \"0\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let one_word =  \"0000000000000000000000000000000000000000000000000000000000000001\" in\n  let two_word =  \"0000000000000000000000000000000000000000000000000000000000000002\" in\n  let three_word =  \"0000000000000000000000000000000000000000000000000000000000000003\" in\n  let seven_word =  \"0000000000000000000000000000000000000000000000000000000000000007\" in\n\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"f(uint256,uint256,uint256)\")^one_word^two_word^three_word\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let answer = eth_call channel c in\n  let () = assert (answer = \"0x\" ^ seven_word) in\n\n  ()\n\n(* takes an address in hex (0x followed by 40 characters) form and returns it as a word (64 characters without 0x) *)\nlet address_as_word address =\n  let () = assert (String.length address = 42) in\n  let () = assert (String.sub address 0 2 = \"0x\") in\n  (String.make 24 '0') ^ (String.sub address 2 40)\n\nlet testing_024 channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/024_vault_shorter.bbo\" in\n  let recover_key = my_acc in\n  let () = Printf.printf \"recover: %s\\n\" recover_key in\n  let vault_key = personal_newAccount channel in\n  let () = Printf.printf \"vault: %s\\n\" vault_key in\n  let hot = personal_newAccount channel in\n  let () = Printf.printf \"hot: %s\\n\" hot in\n\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = vault_key\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"2200000000000000000\"\n    ; data = \"0x00\"\n    ; gasprice = \"0x0000000000000000000000000000000000000000000000000000005af3107a40\"\n    } in\n  let () = ignore (call channel c) in\n\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = hot\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"2200000000000000000\"\n    ; data = \"0x00\"\n    ; gasprice = \"0x0000000000000000000000000000000000000000000000000000005af3107a40\"\n    } in\n  let () = ignore (call channel c) in\n\n\n  let initdata = initcode_compiled ^ address_as_word vault_key ^ address_as_word recover_key in\n  let receipt = deploy_code channel my_acc initdata \"10000\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n  let balance = eth_getBalance channel contract_address in\n  let () = assert (Big_int.(eq_big_int balance (big_int_of_int 10000))) in\n\n  (* initiate a withdrawal *)\n  let unvault : eth_transaction =\n    { from = vault_key\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"unvault(uint256,address)\")^\n               (pad_to_word \"50\")^(address_as_word hot)\n    ; gasprice = \"0x0000000000000000000000000000000000000000000000000000005af3107a40\"\n    } in\n  let unvault_tx = call channel unvault in\n  let () = Printf.printf \"unvault_tx: %Ld\\n\" unvault_tx.blockNumber in\n\n  (* wait for two seconds *)\n  let () = Unix.sleep 2 in\n  let () = advance_block channel in\n\n  let redeem : eth_transaction =\n    { from = hot\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"redeem()\")\n    ; gasprice = \"0x0000000000000000000000000000000000000000000000000000005af3107a40\"\n    } in\n  let redeem_tx = call channel redeem in\n  let () = Printf.printf \"redeem_tx: %Ld\\n\" redeem_tx.blockNumber in\n  let balance = eth_getBalance channel hot in\n  let () = Printf.printf \"hot acccount now has %s\\n%!\" (WrapBn.string_of_big_int balance) in\n  let () = assert(Big_int.(eq_big_int balance (big_int_of_string \"2198885220000000080\"))) in\n\n  ()\n\nlet test_erc20 channel my_acc =\n  let initcode_compiled : string = CompileFile.compile_file \"./src/parse/examples/01b_erc20better.bbo\" in\n  let initial_amount : string = \"0000000000000000000000000000000000000000000000010000000000000000\" in\n\n  let receipt = deploy_code channel my_acc (initcode_compiled ^ initial_amount) \"100000000000000000\" in\n  let contract_address = receipt.contractAddress in\n  let deployed = eth_getCode channel contract_address in\n  let () = assert (String.length deployed > 2) in\n  let () = Printf.printf \"saw code!\\n\" in\n\n  let initialize : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = \"\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let receipt = call channel initialize in\n  let () = Printf.printf \"init tx id: %s\\n\" receipt.transactionHash in\n\n  let less_than_half_amount : string = \"00000000000000000000000000000000000000000000000007f0000000000000\" in\n  let buying : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"100000000000000000\"\n    ; data = (Ethereum.compute_signature_hash \"buy(uint256)\")^less_than_half_amount\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let receipt = call channel buying in\n  let () = Printf.printf \"consumed gas: %s\\n\" (Int64.to_string receipt.gasUsed) in\n  let () = Printf.printf \"buying tx id: %s\\n\" receipt.transactionHash in\n\n  let check_balance : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"balanceOf(address)\")^(pad_to_word (WrapCryptokit.strip_0x my_acc))\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let answer = eth_call channel check_balance in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x\" ^ less_than_half_amount) in\n\n  let second   = personal_newAccount channel in\n  let c : eth_transaction =\n    { from = my_acc\n    ; _to = second\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"1000000000000000000000000\"\n    ; data = \"0x00\"\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n  let () = ignore (call channel c) in\n  let approve : eth_transaction =\n    { from = my_acc\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"approve(address,uint256)\")^\n               (pad_to_word (WrapCryptokit.strip_0x second)) ^\n                 less_than_half_amount\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let receipt = call channel approve in\n  let () = Printf.printf \"approve tx id: %s\\n\" receipt.transactionHash in\n\n  let see_allowance : eth_transaction =\n    { from = second\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"allowance(address,address)\")^\n               (pad_to_word (WrapCryptokit.strip_0x my_acc)) ^\n               (pad_to_word (WrapCryptokit.strip_0x second))\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let answer = eth_call channel see_allowance in\n  let () = assert (answer = \"0x\" ^ less_than_half_amount) in\n\n  let use_allowance : eth_transaction =\n    { from = second\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"transferFrom(address,address,uint256)\")^\n               (pad_to_word (WrapCryptokit.strip_0x my_acc)) ^\n               (pad_to_word (WrapCryptokit.strip_0x second)) ^\n                 less_than_half_amount\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let receipt = call channel use_allowance in\n\n  let check_balance : eth_transaction =\n    { from = second\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"balanceOf(address)\")^(pad_to_word (WrapCryptokit.strip_0x second))\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let answer = eth_call channel check_balance in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x\" ^ less_than_half_amount) in\n\n  let see_allowance : eth_transaction =\n    { from = second\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"allowance(address,address)\")^\n               (pad_to_word (WrapCryptokit.strip_0x my_acc)) ^\n               (pad_to_word (WrapCryptokit.strip_0x second))\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let answer = eth_call channel see_allowance in\n  let () = Printf.printf \"got answer: %s\\n%!\" answer in\n  let () = assert (answer = \"0x\" ^ zero_word) in\n\n  let weis = \"0000000000000000000000000000000000000000000000000010000000000000\" in\n\n  let second_orig_balance = eth_getBalance channel second in\n  let selling : eth_transaction =\n    { from = second\n    ; _to = contract_address\n    ; gas = \"0x0000000000000000000000000000000000000000000000000000000005f5e100\"\n    ; value = \"0\"\n    ; data = (Ethereum.compute_signature_hash \"sell(uint256,uint256)\")^less_than_half_amount^weis\n    ; gasprice = \"0x00000000000000000000000000000000000000000000000000005af3107a4000\"\n    } in\n\n  let receipt = call channel selling in\n  let second_new_balance = eth_getBalance channel second in\n\n  let () = assert (Big_int.gt_big_int second_new_balance second_orig_balance) in\n  let answer = eth_call channel check_balance in\n  let () = assert (answer = \"0x\" ^ zero_word) in\n  ()\n\nlet () =\n  let s = Utils.open_connection_unix_fd filename in\n  let my_acc = constructor_arg_test s in\n  let () = testing_00h_early s my_acc in\n  let () = testing_00h_timeout s my_acc in\n  let () = testing_00bb s my_acc in\n  let () = testing_006 s my_acc in\n  let () = testing_00b s my_acc in\n  let () = random_ecdsa s my_acc in\n  let () = correct_ecdsa s my_acc in\n  let () = testing_010 s my_acc in\n  let () = testing_00i s my_acc in\n  let () = testing_011 s my_acc in\n  let () = testing_013 s my_acc in\n  let () = testing_014 s my_acc in\n  let () = testing_016 s my_acc in\n  let () = testing_mapmap_non_interference s my_acc in\n  let () = testing_019 s my_acc in\n  let () = testing_01a s my_acc in\n  let () = test_erc20 s my_acc in\n  let () = testing_022 s my_acc in\n  let () = testing_024 s my_acc in\n  let () = Unix.close s in\n  ()\n\n(* ocaml-rpc formats every message as an HTTP request while geth does not expect this *)\n(* ocaml-bitcoin is similar.  It always adds HTTP headers *)\n"
  },
  {
    "path": "src/exec-js/bambooJs.ml",
    "content": "open Lexer\nopen Syntax\nopen Codegen\n\nlet parse_with_error lexbuf =\n  try Parser.file Lexer.read lexbuf with\n  | SyntaxError msg ->\n    failwith msg\n  | Parser.Error ->\n    failwith \"syntax error\"\n  | _ ->\n    failwith \"syntax error\"\n\nlet compile_file input_file =\n  let lexbuf = Lexing.from_string input_file in\n  let toplevels : unit Syntax.toplevel list = parse_with_error lexbuf in\n  let toplevels = Assoc.list_to_contract_id_assoc toplevels in\n  let toplevels : Syntax.typ Syntax.toplevel Assoc.contract_id_assoc = Type.assign_types toplevels in\n  let contracts = Assoc.filter_map (fun x ->\n                      match x with\n                      | Contract c -> Some c\n                      | _ -> None) toplevels in\n  let () = match contracts with\n  | [] -> ()\n  | _ ->\n     let constructors : constructor_compiled Assoc.contract_id_assoc = compile_constructors contracts in\n     let contracts_layout_info : (Assoc.contract_id * LayoutInfo.contract_layout_info) list =\n       List.map (fun (id, const) -> (id, layout_info_from_constructor_compiled const)) constructors in\n     let layout = LayoutInfo.construct_layout_info contracts_layout_info in\n     let runtime_compiled = compile_runtime layout contracts in\n     let bytecode : WrapBn.t Evm.program =\n       compose_bytecode constructors runtime_compiled (fst (List.hd contracts)) in\n     let () =\n       Evm.print_imm_program bytecode\n     in\n     () in\n  ()\n\n\nexternal resume : unit -> unit = \"process.stdin.resume\" [@@bs.val]\nexternal setEncoding : string -> unit =\n  \"process.stdin.setEncoding\" [@@bs.val]\nexternal stdin_on_data : (_ [@bs.as \"data\"]) -> (string -> unit) -> unit =\n  \"process.stdin.on\" [@@bs.val]\n\nlet () = resume ()\nlet () = setEncoding \"utf8\"\nlet () = stdin_on_data compile_file"
  },
  {
    "path": "src/lib/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: ee03fbfcb0883e448492600c58692ce0)\nversion = \"0.0.01\"\ndescription = \"A compiler targetting Ethereum Virtual Machine\"\narchive(byte) = \"lib.cma\"\narchive(byte, plugin) = \"lib.cma\"\narchive(native) = \"lib.cmxa\"\narchive(native, plugin) = \"lib.cmxs\"\nexists_if = \"lib.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/lib/lib_test.ml",
    "content": "let case0 = (\"pay(address)\", \"0c11dedd\")\n\nlet case1_case : Syntax.usual_case_header =\n  Syntax.(\n  { case_return_typ = []\n  ; case_name = \"pay\"\n  ; case_arguments = [{arg_typ = AddressType; arg_ident = \"addr\"; arg_location = None}]\n  })\n\nlet case2_case : Syntax.usual_case_header =\n  Syntax.(\n    { case_return_typ = [Uint256Type]\n    ; case_name = \"f\"\n    ; case_arguments = [{arg_typ = Uint256Type; arg_ident = \"x\"; arg_location = None}]\n    })\n\nlet case2_hash :string = \"b3de648b\"\n\nlet _ =\n  let () = Printf.printf \"case0 %s %s\\n\" (Ethereum.keccak_signature (fst case0)) (snd case0) in\n  let () = assert (Ethereum.keccak_signature (fst case0) = (snd case0)) in\n  let () = assert (Ethereum.case_header_signature_hash case1_case = (snd case0)) in\n  let () = assert ((Ethereum.case_header_signature_hash case2_case) = case2_hash) in\n  let () = assert (WrapBn.eq_big_int (WrapBn.hex_to_big_int \"01\") WrapBn.unit_big_int) in\n  let () = assert (Ethereum.string_keccak \"\" = Ethereum.hex_keccak \"0x\") in\n  let () = assert (Ethereum.string_keccak \"a\" = Ethereum.hex_keccak \"0x61\") in\n  let () = assert (Ethereum.string_keccak \"ab\" = Ethereum.hex_keccak \"6162\") in\n  Printf.printf \"lib_test: success\\n\"\n"
  },
  {
    "path": "src/parse/META",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: 82d5d9184cfb0635001b4f2d55e8449d)\nversion = \"0.0.03\"\ndescription = \"A compiler targeting Ethereum Virtual Machine\"\nrequires = \"ast menhirLib\"\narchive(byte) = \"parse.cma\"\narchive(byte, plugin) = \"parse.cma\"\narchive(native) = \"parse.cmxa\"\narchive(native, plugin) = \"parse.cmxs\"\nexists_if = \"parse.cma\"\n# OASIS_STOP\n\n"
  },
  {
    "path": "src/parse/README.md",
    "content": "# a parser for the Bamboo language\n\nThe basic set up is based on [Real World OCaml Chapter 16](https://realworldocaml.org/v1/en/html/parsing-with-ocamllex-and-menhir.html).\n"
  },
  {
    "path": "src/parse/examples/000nil.bbo",
    "content": ""
  },
  {
    "path": "src/parse/examples/001empty.bbo",
    "content": "\n\ncontract C() { }\n"
  },
  {
    "path": "src/parse/examples/002comment.bbo",
    "content": "\n\ncontract C() {\n// a comment is ignored.\n}\n"
  },
  {
    "path": "src/parse/examples/003default_abort.bbo",
    "content": "\n\ncontract C() {\n\tdefault\n    {\n\t\tabort;\n    }\n}\n\n"
  },
  {
    "path": "src/parse/examples/004simple_case_abort.bbo",
    "content": "\n\ncontract C() {\ncase (uint256 f(uint256 _x, uint256 _y))\n{\n    abort;\n}\ndefault\n{\n    abort;\n}\n}\n\n"
  },
  {
    "path": "src/parse/examples/005auction_start.bbo",
    "content": "\n\ncontract auction\n  (address _beneficiary\n  ,uint256 _bidding_time\n,address => bool _bids\n\t,uint256 _highest_bid)\n{\n}\n"
  },
  {
    "path": "src/parse/examples/006auction_first_case.bbo",
    "content": "\n\ncontract auction\n  (address _beneficiary\n  ,uint256 _bidding_time\n  ,address => bool _bids\n  ,uint256 _highest_bid)\n{\n   default\n   {\n     return then become\n     auction(_beneficiary, _bidding_time, _bids, value(msg));\n   }\n}\n"
  },
  {
    "path": "src/parse/examples/007auction_first_case_more.bbo",
    "content": "\n\ncontract auction\n  (address _beneficiary\n  ,uint256 _bidding_time\n,address => bool _bids\n\t,uint256 _highest_bid)\n{\n   default\n   {\n     _bids[_beneficiary] = true;\n     return then become\n         auction(_beneficiary, _bidding_time, _bids, value(msg));\n   }\n}\n"
  },
  {
    "path": "src/parse/examples/008new_var.bbo",
    "content": "\n\ncontract auction\n  (address _beneficiary\n  ,uint256 _bidding_time\n,address => bool _bids\n\t,uint256 _highest_bid)\n{\n   default\n   {\n       bool x = true;\n       abort;\n   }\n}\n"
  },
  {
    "path": "src/parse/examples/009new_var_auc.bbo",
    "content": "\n\ncontract auction\n  (address _beneficiary\n  ,uint256 _bidding_time\n,address => bool _bids\n\t,uint256 _highest_bid)\n{\n   default\n   {\nbid new_bid =\ndeploy bid(sender(msg), value(msg), address(this)) with value(msg)\nreentrance { abort; }; // failure throws.\n     _bids[sender(msg)] = true;\n     return then become\n         auction(_beneficiary, _bidding_time, _bids, value(msg));\n   }\n}\ncontract bid\n  (address _sender\n  ,uint256 _value\n  ,address _auction\n  )\n{\n}"
  },
  {
    "path": "src/parse/examples/00a_auc_first_cast.bbo",
    "content": "\n\ncontract auction\n  (address _beneficiary\n  ,uint256 _bidding_time\n,address => bool _bids\n\t,uint256 _highest_bid)\n{\n   default\n   {\nif (now(block) > _bidding_time)\nreturn then become auction_done(_beneficiary, _bids, _highest_bid);\nif (value(msg) < _highest_bid)\n\t\t\tabort;\nbid new_bid =\ndeploy bid(sender(msg), value(msg), this) with value(msg)\n reentrance { abort; }; // failure throws.\n     _bids[sender(msg)] = true;\n     return then become\n         auction(_beneficiary, _bidding_time, _bids, value(msg));\n   }\n}\ncontract auction_done\n(address _bene,\n address => bool _bids,\n uint256 _highest_bid)\n{\n}\ncontract bid\n  (address _sender\n  ,uint256 _value\n  ,address _auction\n  )\n{\n}\n"
  },
  {
    "path": "src/parse/examples/00b_auction_more.bbo",
    "content": "contract auction\n\t(address _beneficiary\n\t,uint256 _bidding_time\n\t,address => bool _bids\n\t,uint256 _highest_bid)\n{\n\tcase (bool bid())\n\t{\n\t\tif (now(block) > _bidding_time)\n\t\t\treturn (false) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t\tif (value(msg) < _highest_bid)\n\t\t\tabort;\n\t\tbid new_bid =\n\t\t\tdeploy bid(sender(msg), value(msg), this) with value(msg)\n\t\t\t\t reentrance { abort; }; // failure throws.\n_bids[address(new_bid)] = true;\n\t\treturn (true) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, value(msg));\n\t}\n\tcase (uint256 highest_bid())\n\t{\n\t\treturn (_highest_bid) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tcase (uint256 bidding_time())\n\t{\n\t\treturn (_bidding_time) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tdefault\n\t{\n\t\tabort; // cancels the call.\n\t}\n\n// When the control reaches the end of a contract block,\n// it causes an abort.\n}\ncontract auction_done\n(address _bene,\n address => bool _bids,\n uint256 _highest_bid)\n{\n}\ncontract bid\n  (address _sender\n  ,uint256 _value\n  ,address _auction\n  )\n{\n}\n"
  },
  {
    "path": "src/parse/examples/00bbauction_first_named_case.bbo",
    "content": "\n\ncontract auction\n  (uint256 _highest_bid)\n{\n   case(bool bid())\n   {\n\tbid new_bid =\n\t\tdeploy bid(sender(msg)) with value(msg)\n\t\t\t reentrance { abort; }; // failure throws.\n     return (true) then become\n     auction(value(msg));\n   }\n}\ncontract bid\n  (address _sender\n  )\n{\n}\n"
  },
  {
    "path": "src/parse/examples/00c_auction.bbo",
    "content": "contract auction\n\t(address _beneficiary\n\t,uint256 _bidding_time\n\t,address => bool _bids\n\t,uint256 _highest_bid)\n{\n\tcase (bool bid())\n\t{\n\t\tif (now(block) > _bidding_time)\n\t\t\treturn (false) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t\tif (value(msg) < _highest_bid)\n\t\t\tabort;\n\t\tbid new_bid =\n\t\t\tdeploy bid(sender(msg), value(msg), this) with value(msg)\n\t\t\t\treentrance { abort; }; // failure throws.\n\t\t_bids[address(new_bid)] = true;\n\t\treturn (true) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, value(msg));\n\t}\n\tcase (uint256 highest_bid())\n\t{\n\t\treturn (_highest_bid) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tcase (uint256 bidding_time())\n\t{\n\t\treturn (_bidding_time) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tcase (address beneficiary())\n    {\n\t\treturn (_beneficiary) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n    }\n\tdefault\n\t{\n\t\tabort; // cancels the call.\n\t}\n\n// When the control reaches the end of a contract block,\n// it causes an abort.\n}\n\n\ncontract bid\n\t(address _bidder\n\t,uint256 _value\n\t,auction _auction)\n{\n\tcase (bool refund())\n\t{\n\t\tif (sender(msg) != _bidder)\n\t\t\tabort;\n        if (_auction.highest_bid() reentrance { abort; } == _value)\n\t\t\tabort;\n\t\tselfdestruct(_bidder);\n\t}\n\tcase (bool pay_beneficiary())\n\t{\nif (iszero(_auction.highest_bid() reentrance { abort; }))\n\t\t\tabort;\naddress beneficiary = _auction.beneficiary() reentrance { abort; };\n\t\tselfdestruct(beneficiary);\n\t}\n\tdefault\n\t{\n\t\tabort;\n\t}\n}\ncontract auction_done\n(address _bene,\n address => bool _bids,\n uint256 _highest_bid)\n{\n}\n"
  },
  {
    "path": "src/parse/examples/00d_auction.bbo",
    "content": "// The contract signature auction(address,uint256,bool[address],uint256) can be used as a continuation\n// of a contract.  When the auction contract is created, bool[address] cannot be passed,\n// so the array is initizilly zeroed out.\n\ncontract auction\n\t(address _beneficiary\n\t,uint256 _bidding_time\n\t,address => bool _bids /// When the contract is created, this must be empty.\n\t,uint256 _highest_bid)\n{\n\tcase (bool bid())\n\t{\n\t\tif (now(block) > _bidding_time)\n\t\t\treturn (false) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t\tif (value(msg) < _highest_bid)\n\t\t\tabort;\n\t\tbid new_bid =\n\t\t\tdeploy bid(sender(msg), value(msg), this) with value(msg)\n\t\t\t\treentrance { abort; }; // failure throws.\n\t\t_bids[address(new_bid)] = true;\n\t\treturn (true) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, value(msg));\n\t}\n\tcase (uint256 highest_bid())\n\t{\n\t\treturn (_highest_bid) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tcase (uint256 bidding_time())\n\t{\n\t\treturn (_bidding_time) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tcase (address beneficiary())\n\t{\n\t\treturn (_beneficiary) then become\n\t\t\tauction(_beneficiary, _bidding_time, _bids, _highest_bid);\n\t}\n\tdefault\n\t{\n\t\tabort; // cancels the call.\n\t}\n\n// When the control reaches the end of a contract block,\n// it causes an abort.\n}\n\n\ncontract bid\n\t(address _bidder\n\t,uint256 _value\n\t,auction _auction) // the compiler is aware that an `auction` account can become an `auction_done` account.\n{\n\tcase (bool refund())\n\t{\n\t\tif (sender(msg) != _bidder)\n\t\t\tabort;\n\t\tif (_auction.bid_is_highest(_value) reentrance { abort; })\n\t\t\tabort;\n\t\tselfdestruct(_bidder);\n\t}\n\tcase (bool pay_beneficiary())\n\t{\n\t\tif (not _auction.bid_is_highest(_value) reentrance { abort; })\n\t\t\tabort;\n\t\taddress beneficiary = _auction.beneficiary() reentrance { abort; };\n\t\tselfdestruct(beneficiary);\n\t}\n\tdefault\n\t{\n\t\tabort;\n\t}\n}\n\ncontract auction_done(address _beneficiary, address => bool _bids, uint256 _highest_bid)\n{\n\tcase (bool bid_is_highest(uint256 _cand))\n\t{\n\t\tif (not _bids[sender(msg)]) abort;\n\t\treturn (_highest_bid == _cand) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t}\n\tcase (address beneficiary())\n\t{\n\t\tif (not _bids[sender(msg)]) abort;\n\t\treturn (_beneficiary) then become auction_done(_beneficiary, _bids, _highest_bid);\n\t}\n\tdefault\n\t{\n\t\tabort;\n\t}\n}\n"
  },
  {
    "path": "src/parse/examples/00e_ecdsarecover.bbo",
    "content": "contract A() {\n\tcase (address a(bytes32 x, uint8 b, bytes32 c, bytes32 d)) {\n\t\treturn (pre_ecdsarecover(x, b, c, d)) then become A();\n\t}\n}"
  },
  {
    "path": "src/parse/examples/00f_bytes32.bbo",
    "content": "contract A () {\n   case(bool f(bytes32 a)) {\n      return (true) then become A();\n   }\n}"
  },
  {
    "path": "src/parse/examples/00g_int8.bbo",
    "content": "contract A () {\n   case(bool f(uint8 a)) {\n      return (true) then become A();\n   }\n}"
  },
  {
    "path": "src/parse/examples/00h_payment_channel.bbo",
    "content": "// based on https://medium.com/@matthewdif/ethereum-payment-channel-in-50-lines-of-code-a94fad2704bc\n\ncontract Channel\n( address channelSender\n, address channelRecipient\n, uint256 startDate\n, uint256 endDate\n, bytes32 => address signatures\n)\n{\n  case(void CloseChannel(bytes32 h, uint8 v, bytes32 r, bytes32 s, uint256 val)) {\n    address signer = pre_ecdsarecover(h, v, r, s);\n    if ((signer != channelSender) && (signer != channelRecipient)) abort;\n    bytes32 proof = keccak256(this, val);\n    if (proof != h) abort;\n    if (iszero(signatures[proof])) {\n      signatures[proof] = signer;\n      return then become Channel(channelSender, channelRecipient, startDate, endDate, signatures);\n    }\n    else if (signatures[proof] != signer) {\n      void = channelRecipient.default() with val reentrance { abort; }; // failure throws.\n      selfdestruct(channelSender);\n    }\n    else\n      abort;\n  }\n\n  case(void ChannelTimeOut()) {\n    if (endDate > now(block))\n      abort;\n    selfdestruct(channelSender);\n  }\n}"
  },
  {
    "path": "src/parse/examples/00i_local_bool.bbo",
    "content": "contract A () {\n   case(bool f(uint8 a)) {\n      bool x = true;\n      return (x) then become A();\n   }\n}"
  },
  {
    "path": "src/parse/examples/010_logical_and.bbo",
    "content": "contract A () {\n   case (bool f(bool a, bool b)) {\n       return (a && b) then become A();\n   }\n}"
  },
  {
    "path": "src/parse/examples/011_keccak256.bbo",
    "content": "contract A() {\n  case(bytes32 f(address a, bytes32 b)) {\n    return(keccak256(a, b)) then become A();\n  }\n}"
  },
  {
    "path": "src/parse/examples/013_iszero.bbo",
    "content": "contract A () {\n  case (bool a(bytes32 x))\n  {\n      return (iszero(x)) then become A();\n  }\n}"
  },
  {
    "path": "src/parse/examples/014_ifelse.bbo",
    "content": "contract A () {\n  case (bool f(bool x, bool y)) {\n     if (x) return (true) then become A ();\n     else if (y) { return (false) then become A (); }\n\n     abort;\n  }\n}\n"
  },
  {
    "path": "src/parse/examples/015_ifblock.bbo",
    "content": "contract A () {\n  case (bool f(bool x)) {\n    if(x) {\n      return(true) then become A();\n    }\n    abort;\n  }\n}\n"
  },
  {
    "path": "src/parse/examples/016_void.bbo",
    "content": "contract A () {\n    case(bool pass(address rec, uint256 amount)) {\n        void = rec.default() with amount reentrance { abort; };\n        return (true) then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/examples/017_return_void.bbo",
    "content": "contract A () {\n    case (void f()) {\n        return then become A ();\n    }\n}\n"
  },
  {
    "path": "src/parse/examples/018_mapmap.bbo",
    "content": "contract A(bool => address => bool mat)\n{\n\tcase (void set(bool x, address y, bool v))\n\t{\n\t\tmat[x][y] = v;\n\t\treturn then become A(mat);\n\t}\n\tcase (bool get(bool x, address y))\n\t{\n\t\treturn (mat[x][y]) then become A(mat);\n\t}\n}\n"
  },
  {
    "path": "src/parse/examples/019_something.bbo",
    "content": "contract PreToken\n(uint256 totalSupply\n,address initialOwner\n,address => uint256 balances\n)\n{\n\tdefault\n\t{\n\t\tbalances[initialOwner] = totalSupply;\n\t\treturn then become Token(totalSupply, balances);\n\t}\n}\n\ncontract Token\n(uint256 totalSupply\n,address => uint256 balances)\n{\n\tcase(uint256 totalSupply())\n\t{\n\t\treturn totalSupply then become Token(totalSupply, balances);\n\t}\n\tcase(uint256 balanceOf(address a))\n\t{\n\t\treturn balances[a] then become Token(totalSupply, balances);\n\t}\n\tcase(bool transfer(address _to, uint256 _value))\n\t{\n\t\tif (balances[sender(msg)] < _value) abort;\n\t\tif (sender(msg) == _to) return true then become Token(totalSupply, balances);\n\t\tbalances[sender(msg)] = balances[sender(msg)] - _value;\n\t\tif ((balances[_to] + _value) < balances[_to]) abort;\n\t\tbalances[_to] = balances[_to] + _value;\n\t\treturn true then become Token(totalSupply, balances);\n\t}\n}\n"
  },
  {
    "path": "src/parse/examples/01a_event.bbo",
    "content": "event E(uint256 indexed a);\n\ncontract A ()\n{\n    case(void e(uint256 v)) {\n            log E(v);\n            return then become A();\n    }\n}"
  },
  {
    "path": "src/parse/examples/01b_erc20better.bbo",
    "content": "contract PreToken\n(uint256 totalSupply\n,address => uint256 balances\n,address => address => uint256 allowances\n)\n{\n    default\n    {\n        balances[this] = totalSupply;\n        return then become Token(totalSupply, balances, allowances);\n    }\n}\n\nevent Transfer(address indexed _from, address indexed _to, uint256 _amount);\nevent Buy(address indexed _buyer, uint256 _amount, uint256 _value);\nevent Sell(address indexed _buyer, uint256 _amount, uint256 _value);\nevent Approval(address indexed _owner, address indexed _spender, uint256 _value);\n\ncontract Token\n(uint256 totalSupply\n,address => uint256 balances\n,address => address => uint256 allowances\n)\n{\n    case(uint256 totalSupply())\n    {\n        return totalSupply then become Token(totalSupply, balances, allowances);\n    }\n    case(uint256 balanceOf(address a))\n    {\n        return balances[a] then become Token(totalSupply, balances, allowances);\n    }\n\n    case(bool transfer(address _to, uint256 _amount))\n    {\n        if (balances[sender(msg)] < _amount) abort;\n        if (sender(msg) == _to)\n        {\n            log Transfer(sender(msg), sender(msg), _amount);\n            return true then become Token(totalSupply, balances, allowances);\n        }\n        balances[sender(msg)] = balances[sender(msg)] - _amount;\n        if (balances[_to] + _amount < balances[_to]) abort;\n        balances[_to] = balances[_to] + _amount;\n        log Transfer(sender(msg), _to, _amount);\n        return true then become Token(totalSupply, balances, allowances);\n    }\n\n    case(bool approve(address _spender, uint256 _amount))\n    {\n        if (balances[sender(msg)] < _amount) abort;\n        if (sender(msg) == _spender) abort;\n        allowances[sender(msg)][_spender] = _amount;\n        log Approval(sender(msg), _spender, _amount);\n        return true then become Token(totalSupply, balances, allowances);\n    }\n    case(uint256 allowance(address _owner, address _spender))\n    {\n        return allowances[_owner][_spender] then become Token(totalSupply, balances, allowances);\n    }\n    case(bool transferFrom(address _from, address _to, uint256 _amount))\n    {\n        if (balances[_from] < _amount) abort;\n        if (allowances[_from][sender(msg)] < _amount) abort;\n        if (_from == _to)\n        {\n            log Transfer(_from, _to, _amount);\n            return true then become Token(totalSupply, balances, allowances);\n        }\n\n        balances[_from] = balances[_from] - _amount;\n        allowances[_from][sender(msg)] = allowances[_from][sender(msg)] - _amount;\n        balances[_to] = balances[_to] + _amount;\n        log Transfer(_from, _to, _amount);\n        return true then become Token(totalSupply, balances, allowances);\n    }\n\n    case(bool buy(uint256 _amount))\n    {\n        if (balances[this] < _amount) abort;\n        if (balances[sender(msg)] + _amount < balances[sender(msg)]) abort;\n\n        uint256 old_eth_balance = balance(this) - value(msg);\n        if (balance(this) * _amount > (balances[this] - _amount) * value(msg)) abort;\n\n        balances[this] = balances[this] - _amount;\n        balances[sender(msg)] = balances[sender(msg)] + _amount;\n\n        log Buy(sender(msg), _amount, value(msg));\n        return true then become Token(totalSupply, balances, allowances);\n    }\n    case (bool sell(uint256 _amount, uint256 _value))\n    {\n        if (balance(this) < _value) abort;\n        if (balances[sender(msg)] < _amount) abort;\n        if (balances[this] + _amount < balances[this]) abort;\n        if (not (iszero(value(msg)))) abort;\n\n        uint256 old_eth_balance = balance(this);\n        uint256 new_eth_balance = balance(this) - _value;\n        uint256 new_amount = balances[this] + _amount;\n        if (new_eth_balance * _amount < new_amount * _value) abort;\n\n        balances[this] = new_amount;\n        balances[sender(msg)] = balances[sender(msg)] - _amount;\n        log Sell(sender(msg), _amount, _value);\n        void = sender(msg).default() with _value reentrance { abort; };\n        return true then become Token(totalSupply, balances, allowances);\n    }\n}\n"
  },
  {
    "path": "src/parse/examples/020_plus_mult.bbo",
    "content": "contract A () {\n   case (uint256 f(uint256 a, uint256 b, uint256 c)) {\n      return a + b * c then become A();\n   }\n}"
  },
  {
    "path": "src/parse/examples/021_land_neq.bbo",
    "content": "contract A () {\n   case (bool f()) {\n      return true && false != true then become A();\n   }\n}"
  },
  {
    "path": "src/parse/examples/022_plus_gt.bbo",
    "content": "contract A ()\n{\n\tcase(bool f(uint256 a, uint256 b, uint256 c))\n\t{\n\t\treturn a + b < c then become A();\n\t}\n}"
  },
  {
    "path": "src/parse/examples/024_vault.bbo",
    "content": "// Based on http://www.blunderingcode.com/ether-vaults/\n\ncontract Vault(address vaultKey, address recoveryKey) {\n  case(void unvault(uint256 _amount, address _hotWallet)) {\n    if (sender(msg) != vaultKey) abort;\n    uint256 unvaultPeriod = 60 * 60 * 24 * 7 * 2; // two weeks\n    if (now(block) + unvaultPeriod < now(block)) abort;\n    return then become UnVaulting(now(block) + unvaultPeriod, _amount, _hotWallet, vaultKey, recoveryKey);\n  }\n  case(void destroy()) {\n    if (sender(msg) != recoveryKey) abort;\n    return then become Destroyed();\n  }\n  default {\n    return then become Vault(vaultKey, recoveryKey);\n  }\n}\n\ncontract UnVaulting(uint256 redeemtime, uint256 amount, address hotWallet, address vaultKey, address recoveryKey) {\n  case(void redeem()) {\n    if (amount > balance(this)) abort;\n    void = hotWallet.default() with amount reentrance { abort; };\n    return then become Vault(vaultKey, recoveryKey);\n  }\n  case(void recover()) {\n    if (sender(msg) != recoveryKey) abort;\n    return then become Vault(vaultKey, recoveryKey);\n  }\n  case(void destroy()) {\n    if (sender(msg) != recoveryKey) abort;\n    return then become Destroyed();\n  }\n  default {\n    return then become UnVaulting(redeemtime, amount, hotWallet, vaultKey, recoveryKey);\n  }\n}\n\ncontract Destroyed() {\n  // any call just throws;\n}\n"
  },
  {
    "path": "src/parse/examples/024_vault_shorter.bbo",
    "content": "// Based on http://www.blunderingcode.com/ether-vaults/\n\ncontract Vault(address vaultKey, address recoveryKey) {\n  case(void unvault(uint256 _amount, address _hotWallet)) {\n    if (sender(msg) != vaultKey) abort;\n    uint256 unvaultPeriod = 2; // two seconds\n    if (now(block) + unvaultPeriod < now(block)) abort;\n    return then become UnVaulting(now(block) + unvaultPeriod, _amount, _hotWallet, vaultKey, recoveryKey);\n  }\n  case(void destroy()) {\n    if (sender(msg) != recoveryKey) abort;\n    return then become Destroyed();\n  }\n  default {\n    return then become Vault(vaultKey, recoveryKey);\n  }\n}\n\ncontract UnVaulting(uint256 redeemtime, uint256 amount, address hotWallet, address vaultKey, address recoveryKey) {\n  case(void redeem()) {\n    if (amount > balance(this)) abort;\n    void = hotWallet.default() with amount reentrance { abort; };\n    return then become Vault(vaultKey, recoveryKey);\n  }\n  case(void recover()) {\n    if (sender(msg) != recoveryKey) abort;\n    return then become Vault(vaultKey, recoveryKey);\n  }\n  case(void destroy()) {\n    if (sender(msg) != recoveryKey) abort;\n    return then become Destroyed();\n  }\n  default {\n    return then become UnVaulting(redeemtime, amount, hotWallet, vaultKey, recoveryKey);\n  }\n}\n\ncontract Destroyed() {\n  // any call just throws;\n}\n"
  },
  {
    "path": "src/parse/examples/025_declit_numeric.bbo",
    "content": "contract A ()\n{\n    case(bool f(uint256 a))\n    {\n        return a < 5 then become A();\n    }\n    case(uint256 g(uint256 a))\n    {\n        return 1 + 9 then become A();\n    }\n    case(uint256 gg(uint256 a))\n    {\n        return 12138129191999999999 + 9213817283712 then become A();\n    }\n    case(uint256 ggg(uint256 a))\n    {\n        return 77712138129191999999999 - 9 then become A();\n    }\n    case(bool s())\n    {\n        return 239842934 > 289302 then become A();\n    }\n    case(uint8 i(uint8 a))\n    {\n        return 12u8 + 5u8 then become A();\n    }\n    case(uint8 j())\n    {\n        return 12u8 - 5u8 then become A();\n    }\n    case(uint8 jjjj())\n    {\n        return 120u8 + 255u8 then become A();\n    }\n    case(bool k())\n    {\n        return 12u8 > 5u8 then become A();\n    }\n    case(bool q(uint8 a))\n    {\n        return a < 5u8 then become A();\n    }\n    case(uint8 multiply5(uint8 a))\n    {\n        return a * 5u8 then become A();\n    }\n    case(uint256 multiply7(uint256 a))\n    {\n        return a * 7 then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/examples/026_abc.bbo",
    "content": "contract A()\n{\n    case (uint256 f()) {\n        return 0 then become B();\n    }\n}\ncontract B()\n{\n    case (uint256 f()) {\n        return 1 then become C();\n    }\n}\ncontract C()\n{\n    case (uint256 f()) {\n        return 2 then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/examples/027_counting.bbo",
    "content": "contract A(uint256 counter)\n{\n    case (uint256 f()) {\n        return counter then become A(counter + 1);\n    }\n}"
  },
  {
    "path": "src/parse/lexer.mll",
    "content": "(* Some code in this file comes from\n * https://github.com/realworldocaml/examples/tree/master/code/parsing-test\n * which is under UNLICENSE\n *)\n{\n  open Lexing\n  open Parser\n  exception SyntaxError of string\n}\n\nlet white = [' ' '\\t']+\nlet newline = '\\r' | '\\n' | \"\\r\\n\"\nlet digit = ['0'-'9']\nlet id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']*\nlet comment = \"//\" (_ # ['\\r' '\\n'])* newline\n\nrule read =\n  parse\n  | white    { read lexbuf }\n  | comment  { new_line lexbuf; read lexbuf }\n  | newline  { new_line lexbuf; read lexbuf }\n  | \"contract\" { CONTRACT }\n  | \"default\"  { DEFAULT }\n  | \"case\"     { CASE }\n  | \"abort\"    { ABORT }\n  | \"uint8\"    { UINT8 }\n  | \"uint256\"  { UINT256 }\n  | \"bytes32\"  { BYTES32 }\n  | \"address\"  { ADDRESS }\n  | \"bool\"     { BOOL }\n  | \"[\"        { LSQBR }\n  | \"]\"        { RSQBR }\n  | \"if\"       { IF }\n  | \"else\"     { ELSE }\n  | \"true\"     { TRUE }\n  | \"false\"    { FALSE }\n  | \"then\"     { THEN }\n  | \"become\"   { BECOME }\n  | \"return\"   { RETURN }\n  | \";\" { SEMICOLON }\n  | \"(\" { LPAR }\n  | \")\" { RPAR }\n  | \"{\" { LBRACE }\n  | \"}\" { RBRACE }\n  | \",\" { COMMA }\n  | \"==\" { EQUALITY }\n  | \"!=\" { NEQ }\n  | \"<\" { LT }\n  | \">\" { GT }\n  | \"=\"  { SINGLE_EQ }\n  | \"deploy\" { DEPLOY }\n  | \"with\" { ALONG }\n  | \"reentrance\" { REENTRANCE }\n  | \"selfdestruct\" { SELFDESTRUCT }\n  | \".\" { DOT }\n  | \"not\" { NOT }\n  | \"msg\" { MSG }\n  | \"value\" { VALUE }\n  | \"sender\" { SENDER }\n  | \"this\" { THIS }\n  | \"balance\" { BALANCE }\n  | \"now\"  { NOW }\n  | \"block\" { BLOCK }\n  | \"void\" { VOID }\n  | \"&&\" { LAND }\n  | \"=>\" { RARROW }\n  | \"+\" { PLUS }\n  | \"-\" { MINUS }\n  | \"*\" { MULT }\n  | \"event\" { EVENT }\n  | \"log\" { LOG }\n  | \"indexed\" { INDEXED }\n  | digit+ as i { DECLIT256 (WrapBn.big_int_of_string i) }\n  (* uint8 has at most three digits *)\n  | digit digit? digit? \"u8\" as i {\n      let last = String.length i - 2 in\n      DECLIT8 (WrapBn.big_int_of_string (String.sub i 0 last)) }\n  | id  { IDENT (lexeme lexbuf) }\n  | eof { EOF }\n"
  },
  {
    "path": "src/parse/negative_examples/bad_end.bbo",
    "content": "contract A () {\n    default {\n        void = sender(msg).default() reentrance { abort; };\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/duplicate_contract_names.bbo",
    "content": "contract C() { }\ncontract C() { }\n"
  },
  {
    "path": "src/parse/negative_examples/mixed_uints.bbo",
    "content": "contract A ()\n{\n    case(bool f(uint256 a))\n    {\n        return a < 5u8 then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/multi_default.bbo",
    "content": "contract A() {\n   default {\n     abort;\n   }\n\n   default {\n     abort;\n   }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/uint256_too_big.bbo",
    "content": "contract A ()\n{\n    case(bool f(uint256 a))\n    {\n        return a < 115792089237316195423570985008687907853269984665640564039457584007913129639936 then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/uint8_too_big.bbo",
    "content": "contract A ()\n{\n    case(bool f(uint8 a))\n    {\n        return a < 300u8 then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/uint8_with_four_digits.bbo",
    "content": "contract A ()\n{\n    case(bool f(uint8 a))\n    {\n        return a < 1029u8 then become A();\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/unknown_ctor_arg.bbo",
    "content": "contract A(k x) {\n}"
  },
  {
    "path": "src/parse/negative_examples/unknown_return.bbo",
    "content": "contract A() {\n\tcase (xyzxyz a(bytes32 x, bytes32 b, uint8 c, bytes32 d)) {\n\t\treturn (pre_ecdsarecover(x, b, c, d)) then become A();\n\t}\n}\n"
  },
  {
    "path": "src/parse/negative_examples/unknown_type.bbo",
    "content": "contract unknown () {\n   case(bool f(xyz k)) {\n       return (true) then become unknown();\n   }\n}"
  },
  {
    "path": "src/parse/negative_examples/void_not_void.bbo",
    "content": "contract A () {\n    default {\n        void = sender(msg);\n        abort;\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/void_some_return.bbo",
    "content": "contract A () {\n    case (void f(address a)) {\n        return (a) then become A ();\n    }\n}\n"
  },
  {
    "path": "src/parse/negative_examples/wrong_arg.bbo",
    "content": "contract A() {\n\tcase (address a(uint8 x, uint8 b, bytes32 c, bytes32 d)) {\n\t\treturn (pre_ecdsarecover(x, b, c, d)) then become A();\n\t}\n}"
  },
  {
    "path": "src/parse/negative_examples/wrong_return.bbo",
    "content": "contract A () {\n   case(bool f(uint256 x)) {\n       return x then become A();\n   }\n}\n"
  },
  {
    "path": "src/parse/parse.mldylib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: c99c8065d9a0587b2171ca8644cac62d)\nLexer\n# OASIS_STOP\n"
  },
  {
    "path": "src/parse/parse.mllib",
    "content": "# OASIS_START\n# DO NOT EDIT (digest: c99c8065d9a0587b2171ca8644cac62d)\nLexer\n# OASIS_STOP\n"
  },
  {
    "path": "src/parse/parser.mly",
    "content": "%token CONTRACT\n%token <string> IDENT\n%token <WrapBn.t> DECLIT256\n%token <WrapBn.t> DECLIT8\n%token ADDRESS\n%token UINT256\n%token UINT8\n%token BYTES32\n%token BOOL\n%token LPAR\n%token RPAR\n%token PLUS\n%token MINUS\n%token MULT\n%token RARROW\n%token COMMA\n%token LSQBR\n%token RSQBR\n%token LBRACE\n%token RBRACE\n%token DOT\n%token CASE\n%token DEFAULT\n%token IF\n%token ELSE\n%token RETURN\n%token FALSE\n%token TRUE\n%token THEN\n%token BECOME\n%token SEMICOLON\n%token EQUALITY\n%token NEQ\n%token LT\n%token GT\n%token SINGLE_EQ\n%token EVENT\n%token LOG\n%token DEPLOY\n%token ALONG\n%token REENTRANCE\n%token ABORT\n%token SELFDESTRUCT\n%token NOT\n%token VALUE\n%token SENDER\n%token MSG\n%token THIS\n%token LAND\n%token NOW\n%token VOID\n%token BLOCK\n%token INDEXED\n%token BALANCE\n%token EOF\n\n%right RARROW\n\n%left LAND\n%left NEQ EQUALITY LT GT\n%left PLUS MINUS\n%left MULT\n\n%start <unit Syntax.toplevel list> file\n%%\n\n\n%inline plist(X):\n   xs = delimited(LPAR, separated_list(COMMA, X), RPAR) {xs}\n\nfile:\n  | cs = list(contract); EOF; { cs }\n  ;\n\ncontract:\n  | CONTRACT;\n    name = IDENT;\n    args = plist(arg);\n    LBRACE;\n    css = list(case);\n    RBRACE;\n    { Syntax.Contract\n      ({ Syntax.contract_cases = css\n       ; contract_name = name\n       ; contract_arguments = args}) }\n  | EVENT;\n    name = IDENT;\n    args = plist(event_arg);\n    SEMICOLON;\n    { Syntax.Event { Syntax.event_arguments = args\n      ; event_name = name\n      }}\n  ;\n\ncase:\n  | ch  = case_header;\n    cb  = block;\n    {\n      { Syntax.case_header = ch\n      ; Syntax.case_body = cb\n      }\n     }\n  ;\n\nblock:\n  | LBRACE;\n    scs = list(sentence);\n    RBRACE\n    { scs }\n  ;\n\ncase_header:\n  | DEFAULT { Syntax.DefaultCaseHeader }\n  | CASE; LPAR;\n    return_typ = typ;\n    name = IDENT;\n    args = plist(arg);\n    RPAR { Syntax.UsualCaseHeader\n      { case_return_typ = [return_typ] (* multi returns not supported *)\n      ; Syntax.case_name = name\n      ; case_arguments = args\n      }\n    }\n  | CASE; LPAR;\n    VOID;\n    name = IDENT;\n    args = plist(arg);\n    RPAR { Syntax.UsualCaseHeader\n      { case_return_typ = []\n      ; Syntax.case_name = name\n      ; case_arguments = args\n      }\n    }\n  ;\n\narg:\n  | t = typ;\n    i = IDENT\n    { { Syntax.arg_typ = t\n      ; Syntax.arg_ident = i\n      ; Syntax.arg_location = None\n      }\n    }\n  ;\n\nevent_arg:\n  | a = arg { Syntax.event_arg_of_arg a false }\n  | t = typ;\n    INDEXED;\n    i = IDENT\n    { { Syntax.event_arg_body =\n        { Syntax.arg_typ = t\n        ; Syntax.arg_ident = i\n        ; Syntax.arg_location = None\n        }\n      ; Syntax.event_arg_indexed = true\n      }\n    }\n    ;\n\ntyp:\n  | UINT256 { Syntax.Uint256Type }\n  | UINT8 { Syntax.Uint8Type }\n  | BYTES32 { Syntax.Bytes32Type }\n  | ADDRESS { Syntax.AddressType }\n  | BOOL { Syntax.BoolType }\n  | key = typ;\n    RARROW;\n    value = typ;\n    { Syntax.MappingType (key, value) }\n  | s = IDENT { Syntax.ContractInstanceType s }\n  ;\n\n%inline body:\n  | s = sentence {[s]}\n  | b = block {b}\n  ;\n\nsentence:\n  | ABORT; SEMICOLON { Syntax.AbortSentence }\n  | RETURN; value = option(exp); THEN; BECOME; cont = exp; SEMICOLON\n    { Syntax.ReturnSentence { Syntax. return_exp = value; return_cont = cont} }\n  | lhs = lexp; SINGLE_EQ; rhs = exp; SEMICOLON\n    { Syntax.AssignmentSentence (lhs, rhs) }\n  | t = typ;\n    name = IDENT;\n    SINGLE_EQ;\n    value = exp;\n    SEMICOLON { Syntax.VariableInitSentence\n                { Syntax.variable_init_type = t\n                ; variable_init_name = name\n                ; variable_init_value = value\n                }\n              }\n  | VOID; SINGLE_EQ; value = exp; SEMICOLON\n    { Syntax.ExpSentence value }\n  | IF; LPAR; cond = exp; RPAR; bodyT = body; ELSE; bodyF = body { Syntax.IfThenElse (cond, bodyT, bodyF) }\n  | IF; LPAR; cond = exp; RPAR; body = body { Syntax.IfThenOnly (cond, body) }\n  | LOG; name = IDENT; lst = exp_list; SEMICOLON { Syntax.LogSentence (name, lst, None)}\n  | SELFDESTRUCT; e = exp; SEMICOLON { Syntax.SelfdestructSentence e }\n  ;\n\n%inline op:\n  | PLUS {fun (l, r) -> Syntax.PlusExp(l, r)}\n  | MINUS {fun (l, r)  -> Syntax.MinusExp(l, r)}\n  | MULT {fun (l, r) -> Syntax.MultExp(l, r)}\n  | LT {fun (l, r) -> Syntax.LtExp(l, r)}\n  | GT {fun (l, r) -> Syntax.GtExp(l, r)}\n  | NEQ {fun (l, r) -> Syntax.NeqExp(l, r)}\n  | EQUALITY {fun (l, r) -> Syntax.EqualityExp(l, r)}\n  ;\n\nexp:\n  | lhs = exp; LAND; rhs = exp { Syntax.LandExp (lhs, rhs), () }\n  | TRUE { Syntax.TrueExp, () }\n  | FALSE { Syntax.FalseExp, () }\n  | d = DECLIT256 { Syntax.DecLit256Exp d, ()}\n  | d = DECLIT8 { Syntax.DecLit8Exp d, ()}\n  | VALUE LPAR MSG RPAR { Syntax.ValueExp, () }\n  | SENDER LPAR MSG RPAR { Syntax.SenderExp, () }\n  | BALANCE; LPAR; e = exp; RPAR { Syntax.BalanceExp e, () }\n  | NOW LPAR BLOCK RPAR { Syntax.NowExp, () }\n  | lhs = exp; o = op; rhs = exp { (o (lhs, rhs)), () }\n  | s = IDENT\n    { Syntax.IdentifierExp s, () }\n  | LPAR;\n    e = exp;\n    RPAR\n    { Syntax.ParenthExp e, () }\n  | s = IDENT; lst = exp_list { Syntax.FunctionCallExp {Syntax.call_head = s; call_args = lst }, () }\n  | DEPLOY; s = IDENT; lst = exp_list; m = msg_info { Syntax.NewExp { Syntax.new_head = s; new_args = lst; new_msg_info = m }, () }\n  | contr = exp; DOT; DEFAULT;\n    LPAR; RPAR; m = msg_info\n    { Syntax.SendExp { Syntax.send_head_contract = contr; send_head_method = None\n                       ; send_args = []; send_msg_info = m }, () }\n  | contr = exp; DOT; mtd = IDENT; lst = exp_list; m = msg_info\n    { Syntax.SendExp { Syntax.send_head_contract = contr; send_head_method = Some mtd\n                       ; send_args = (lst); send_msg_info = m }, () }\n  | ADDRESS; LPAR; e = exp; RPAR { Syntax.AddressExp e, () }\n  | NOT; e = exp { Syntax.NotExp e, () }\n  | THIS { Syntax.ThisExp, () }\n  | l = lexp;\n    { Syntax.ArrayAccessExp l, () }\n  ;\n\n\n%inline exp_list:\n   lst = plist(exp) {lst}\n\nmsg_info:\n  | v = value_info; r = reentrance_info { { Syntax.message_value_info = v;\n                                            message_reentrance_info = r } }\n  ;\n\nvalue_info:\n  | (* empty *) { None }\n  | ALONG; v = exp; { Some v }\n  ;\n\nreentrance_info:\n  | REENTRANCE; b = block { b }\n  ;\n\nlexp:\n  | s = exp;\n    LSQBR;\n    idx = exp;\n    RSQBR\n    { Syntax.ArrayAccessLExp {\n       Syntax.array_access_array = s; array_access_index = idx} }\n  ;\n"
  },
  {
    "path": "src/parse/parser_test.ml",
    "content": "open Lexer\nopen Lexing\nopen Printf\n\n(* The following two functions comes from\n * https://github.com/realworldocaml/examples/tree/master/code/parsing-test\n * which is under UNLICENSE\n *)\nlet print_position outx lexbuf =\n  let pos = lexbuf.lex_curr_p in\n  fprintf outx \"%s:%d:%d\" pos.pos_fname\n    pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)\n\nlet parse_with_error lexbuf =\n  try Parser.file Lexer.read lexbuf with\n  | SyntaxError msg ->\n    fprintf stderr \"%a: %s\\n\" print_position lexbuf msg;\n    exit (-1)\n  | Parser.Error ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n  | _ ->\n    fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n    exit (-1)\n\nlet _ =\n  let lexbuf = Lexing.from_channel stdin in\n  let _ = parse_with_error lexbuf in\n  Printf.printf \"Finished parsing.\\n\"\n"
  },
  {
    "path": "src/run_tests.sh",
    "content": "npm run build\nlib_path=\"../lib/bs/native/\"\n$lib_path\"codegen_test.native\" || exit 1\n$lib_path\"lib_test.native\" || exit 1\n$lib_path\"hex_test.native\" || exit 1\nfor f in `ls parse/examples/*.bbo ../sketch/*.bbo`\ndo\n  echo \"trying\" $f\n  cat $f | $lib_path\"parser_test.native\" || \\\n  exit 1\n  cat $f | $lib_path\"ast_test.native\" || \\\n  exit 1\n  cat $f | $lib_path\"codegen_test2.native\" || \\\n  exit 1\n  cat $f | $lib_path\"bamboo.native\" --abi | jq || \\\n  exit 1\ndone\nfor f in `ls parse/negative_examples/*.bbo`\ndo\n  echo \"trying\" $f\n  if cat $f | $lib_path\"codegen_test2.native\"\n  then\n    exit 1\n  fi\ndone\necho \"what should succeed has succeeded; what should fail has failed.\"\n"
  }
]