├── .github └── workflows │ └── gitstamp.yaml ├── .gitignore ├── AUTHORS ├── CHANGES.md ├── CREDITS.md ├── README.md ├── Rakefile ├── TODO.md ├── UNLICENSE ├── VERSION ├── bin ├── .gitkeep └── clarc │ ├── .gitkeep │ ├── Options.ml │ ├── Options.mli │ ├── Target.ml │ ├── Target.mli │ ├── clarc.ml │ └── dune ├── dune-project ├── dune-workspace ├── etc ├── .gitkeep ├── examples │ ├── .gitkeep │ ├── counter.clar │ ├── counter.json │ ├── counter.sol │ ├── kv-store.clar │ ├── kv-store.json │ ├── kv-store.sol │ ├── panic.clar │ ├── panic.json │ └── panic.sol ├── flowchart.png ├── manpage.jpg └── mew-deploy.jpg ├── lib ├── .gitkeep ├── Clar2EVM │ ├── .gitkeep │ ├── Clar2EVM.ml │ ├── Clar2EVM.mli │ ├── compile.ml │ ├── compile.mli │ ├── dune │ ├── features.ml │ ├── features.mli │ ├── typecheck.ml │ ├── typecheck.mli │ ├── utility.ml │ └── utility.mli └── EVM │ ├── .gitkeep │ ├── EVM.ml │ ├── EVM.mli │ ├── abi.ml │ ├── abi.mli │ ├── construct.ml │ ├── construct.mli │ ├── debug.ml │ ├── debug.mli │ ├── decode.ml │ ├── decode.mli │ ├── dune │ ├── encode.ml │ ├── encode.mli │ ├── metrics.ml │ ├── metrics.mli │ ├── opcodes.ml │ ├── print.ml │ ├── print.mli │ ├── utility.ml │ └── utility.mli └── test ├── .gitkeep ├── contracts.t ├── definitions.t ├── dune ├── functions.t ├── keywords.t ├── literals.t ├── operators.t └── test_hash.ml /.github/workflows/gitstamp.yaml: -------------------------------------------------------------------------------- 1 | # See: https://github.com/weavery/gitstamp-action 2 | --- 3 | name: Gitstamp 4 | on: 5 | push: 6 | branches: 7 | - master 8 | jobs: 9 | gitstamp: 10 | runs-on: ubuntu-latest 11 | name: Timestamp commit with Gitstamp 12 | steps: 13 | - name: Clone repository 14 | uses: actions/checkout@v2 15 | - name: Submit Gitstamp transaction 16 | uses: weavery/gitstamp-action@v1 17 | with: 18 | wallet-key: ${{ secrets.GITSTAMP_KEYFILE }} 19 | commit-link: true 20 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # macOS 2 | .DS_Store 3 | 4 | # Visual Studio Code 5 | .vscode/ 6 | 7 | # Dune artifacts 8 | _build/ 9 | .merlin 10 | 11 | # Editor backup files 12 | *~ 13 | 14 | # Pandoc outputs 15 | *.html 16 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Arto Bendiken 2 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | All notable changes to this project will be documented in this file. 4 | 5 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 6 | and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 7 | -------------------------------------------------------------------------------- /CREDITS.md: -------------------------------------------------------------------------------- 1 | # Credits 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Clarc 2 | 3 | [![Project license](https://img.shields.io/badge/license-Public%20Domain-blue.svg)](https://unlicense.org) 4 | [![Discord](https://img.shields.io/discord/755852964513579099?label=discord)](https://discord.gg/AvHRCDa) 5 | 6 | **Clarc** compiles [Clarity] smart contracts into [Ethereum] virtual machine 7 | (EVM) bytecode. 8 | 9 | More specifically, the Clarc compiler, called `clarc`, parses `.clar` files and 10 | compiles them into an equivalent EVM bytecode program that runs on the Ethereum 11 | blockchain. 12 | 13 | [![Screencast](https://asciinema.org/a/365265.svg)](https://asciinema.org/a/365265) 14 | 15 | *Note: Here be dragons. This is a pre-alpha, work-in-progress 16 | project. Assume nothing works, and you may be pleasantly surprised on 17 | occasion.* 18 | 19 | ## Installation 20 | 21 | ### Binary Downloads 22 | 23 | The latest release binaries for macOS and Linux are available here: 24 | 25 | - [clarc-0.5.0-macos.tar.gz](https://github.com/weavery/clarc/releases/download/0.5.0/clarc-0.5.0-macos.tar.gz) 26 | 27 | - [clarc-0.5.0-linux.tar.gz](https://github.com/weavery/clarc/releases/download/0.5.0/clarc-0.5.0-linux.tar.gz) 28 | 29 | To install, just download and untar the archive and then copy the resulting 30 | binary to `/usr/local/bin`, as follows: 31 | 32 | #### macOS 33 | 34 | ```bash 35 | wget https://github.com/weavery/clarc/releases/download/0.5.0/clarc-0.5.0-macos.tar.gz 36 | 37 | tar xf clarc-0.5.0-macos.tar.gz 38 | 39 | sudo install clarc-0.5.0-macos /usr/local/bin/clarc 40 | ``` 41 | 42 | #### Linux 43 | 44 | ```bash 45 | wget https://github.com/weavery/clarc/releases/download/0.5.0/clarc-0.5.0-linux.tar.gz 46 | 47 | tar xf clarc-0.5.0-linux.tar.gz 48 | 49 | sudo install clarc-0.5.0-linux /usr/local/bin/clarc 50 | ``` 51 | 52 | ### Source Code 53 | 54 | If you wish to try out the latest and greatest Clarc, you will need to build 55 | it from source code yourself, which entails setting up an [OCaml] development 56 | environment. Reserve at least half an hour of time and 57 | [see further down](#development) in this document for the particulars. 58 | 59 | ## Usage 60 | 61 | To view Clarc's built-in man page that documents all command-line options, run: 62 | 63 | ```bash 64 | clarc --help 65 | ``` 66 | 67 | ![Manpage](https://github.com/weavery/clarc/blob/master/etc/manpage.jpg) 68 | 69 | ### Compiling to opcode 70 | 71 | To compile the Clarity [`counter.clar`] example contract to programmer-readable 72 | output, known as symbolic opcode, run: 73 | 74 | ```bash 75 | clarc -t opcode counter.clar 76 | ``` 77 | 78 | The previous writes out the compiled program to standard output, which is 79 | helpful during development and debugging. 80 | 81 | ### Compiling to bytecode 82 | 83 | To compile the Clarity [`counter.clar`] example contract to deployable 84 | bytecode, run: 85 | 86 | ```bash 87 | clarc -t bytecode counter.clar 88 | ``` 89 | 90 | Alternatively, you can specify an output file name in the usual way, with the 91 | target type inferred from the output file extension (`.bin` for bytecode, 92 | in keeping with the Solidity compiler): 93 | 94 | ```bash 95 | clarc -o counter.bin counter.clar 96 | ``` 97 | 98 | ### Deploying the contract 99 | 100 | [MyEtherWallet] is the easiest way to deploy the generated contracts: 101 | 102 | ![Deploy a Contract](https://github.com/weavery/clarc/blob/master/etc/mew-deploy.jpg) 103 | 104 | ## Examples 105 | 106 | ### Supported Contracts 107 | 108 | The currently tested contracts, deployed to the public [Ropsten] testnet, are: 109 | 110 | | Contract ID | Contract Code | Contract Bytecode | Contract ABI | 111 | | :---------- | :------------ | :---------------- | :----------- | 112 | | [0x8a90b1e93020933295b3bd4ce2317062319351d4] | [`counter.clar`] | [`counter.bin`] | [`counter.json`] | 113 | | [0x2e2487c64b1420111e8d66d751f75f69515c5476] | [`kv-store.clar`] | [`kv-store.bin`] | [`kv-store.json`] | 114 | | [0x9a1b29fc432af1e37af03ed2fee00d742ff7372f] | [`panic.clar`] | [`panic.bin`] | [`panic.json`] | 115 | 116 | [MyEtherWallet] is the easiest way to interact with these deployed contracts. 117 | 118 | [0x8a90b1e93020933295b3bd4ce2317062319351d4]: https://ropsten.etherscan.io/address/0x8a90b1e93020933295b3bd4ce2317062319351d4 119 | [0x2e2487c64b1420111e8d66d751f75f69515c5476]: https://ropsten.etherscan.io/address/0x2e2487c64b1420111e8d66d751f75f69515c5476 120 | [0x9a1b29fc432af1e37af03ed2fee00d742ff7372f]: https://ropsten.etherscan.io/address/0x9a1b29fc432af1e37af03ed2fee00d742ff7372f 121 | 122 | ### Example: Counter 123 | 124 | #### [`counter.clar`] 125 | 126 | ```scheme 127 | (define-data-var counter int 0) 128 | 129 | (define-read-only (get-counter) 130 | (ok (var-get counter))) 131 | 132 | (define-public (increment) 133 | (begin 134 | (var-set counter (+ (var-get counter) 1)) 135 | (ok (var-get counter)))) 136 | 137 | (define-public (decrement) 138 | (begin 139 | (var-set counter (- (var-get counter) 1)) 140 | (ok (var-get counter)))) 141 | ``` 142 | 143 | #### `counter.opcode` 144 | 145 | ```bash 146 | $ clarc counter.clar -t opcode 147 | PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x64 DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY 148 | PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1 149 | PUSH4 0x8ada066e EQ PUSH1 0x28 JUMPI DUP1 PUSH4 0xd09de08a EQ PUSH1 0x36 150 | JUMPI DUP1 PUSH4 0x2baeceb7 EQ PUSH1 0x4d JUMPI STOP JUMPDEST POP PUSH1 0x00 151 | SLOAD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP JUMPDEST POP 152 | PUSH1 0x01 PUSH1 0x00 SLOAD ADD PUSH1 0x00 SSTORE PUSH1 0x00 SLOAD PUSH1 0x00 153 | MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP JUMPDEST POP PUSH1 0x01 PUSH1 0x00 154 | SLOAD SUB PUSH1 0x00 SSTORE PUSH1 0x00 SLOAD PUSH1 0x00 MSTORE PUSH1 0x20 155 | PUSH1 0x00 RETURN STOP 156 | ``` 157 | 158 | #### [`counter.bin`] 159 | 160 | ```bash 161 | $ clarc counter.clar -t bytecode 162 | 600060005560648060106000396000f360e060020a6000350480638ada066e146028578063d09de08a1460365780632baeceb714604d57005b5060005460005260206000f3005b5060016000540160005560005460005260206000f3005b5060016000540360005560005460005260206000f300 163 | ``` 164 | 165 | ## Design 166 | 167 | Clarc is written in [OCaml], an excellent programming language for crafting 168 | compiler toolchains. 169 | 170 | Clarc is a standard multi-pass compiler consisting of the following stages: 171 | 172 | ![Flowchart](https://github.com/weavery/clarc/blob/master/etc/flowchart.png) 173 | 174 | The Clarity parser and abstract syntax tree ([AST]) are maintained as a 175 | subproject in an OCaml library called [Clarity.ml]. The library enables anyone 176 | familiar with OCaml to quickly and easily develop more best-of-class tooling 177 | for Clarity contracts. 178 | 179 | ### Lexical analysis 180 | 181 | See Clarity.ml's [`lexer.mll`] for the lexical analyzer source code. 182 | 183 | [`lexer.mll`]: https://github.com/weavery/clarity.ml/blob/master/src/lexer.mll 184 | 185 | ### Syntactic analysis 186 | 187 | See Clarity.ml's [`parser.mly`] and [`parse.ml`] for the parser source code. 188 | 189 | [`parse.ml`]: https://github.com/weavery/clarity.ml/blob/master/src/parse.ml 190 | [`parser.mly`]: https://github.com/weavery/clarity.ml/blob/master/src/parser.mly 191 | 192 | ### Semantic analysis 193 | 194 | See Clarity.ml's [`grammar.ml`] for the structure of the Clarity [AST]. 195 | 196 | [`grammar.ml`]: https://github.com/weavery/clarity.ml/blob/master/src/grammar.ml 197 | 198 | ## Development 199 | 200 | This section documents how to get set up with a development environment for 201 | building Clarc from source code. It is only of interest to people who wish to 202 | contribute to Clarc. 203 | 204 | ### Prerequisites 205 | 206 | The following baseline tooling is required in order to build Clarc from source 207 | code: 208 | 209 | - [Git](https://git-scm.com/downloads) 210 | 211 | - [OCaml] 4.11+ 212 | 213 | - [OPAM](https://opam.ocaml.org) 214 | 215 | - [Dune](https://dune.build) 216 | 217 | - [Docker](https://docs.docker.com/get-docker/) (for release builds only) 218 | 219 | We would recommend you *don't* install OCaml from a package manager. 220 | 221 | Rather, [get set up with OPAM](https://opam.ocaml.org/doc/Install.html) and 222 | then let OPAM install the correct version of OCaml as follows: 223 | 224 | ```bash 225 | opam init -c 4.11.1 # if OPAM not yet initialized 226 | opam switch create 4.11.1 # if OPAM already initialized 227 | ``` 228 | 229 | Once OPAM and OCaml are available, install Dune as follows: 230 | 231 | ```bash 232 | opam install dune 233 | ``` 234 | 235 | ### Dependencies 236 | 237 | The following OCaml tools and libraries are required in order to build 238 | Clarc from source code: 239 | 240 | - [Alcotest](https://opam.ocaml.org/packages/alcotest/) 241 | for unit tests 242 | 243 | - [Clarity.ml] for parsing Clarity code 244 | 245 | - [Cmdliner](https://opam.ocaml.org/packages/cmdliner/) 246 | for the command-line interface 247 | 248 | - [Cppo](https://opam.ocaml.org/packages/cppo/) 249 | for code preprocessing 250 | 251 | - [Cryptokit](https://opam.ocaml.org/packages/cryptokit/) 252 | for the Keccak-256 hash function 253 | 254 | - [ISO8601](https://opam.ocaml.org/packages/ISO8601/) 255 | for date handling 256 | 257 | - [Num](https://opam.ocaml.org/packages/num/) 258 | for 128-bit integers 259 | 260 | - [Ocolor](https://opam.ocaml.org/packages/ocolor/) 261 | for terminal colors 262 | 263 | These aforementioned dependencies are all best installed via OPAM: 264 | 265 | ```bash 266 | opam install -y alcotest cmdliner cppo cryptokit iso8601 num ocolor 267 | opam pin add -y clarity-lang https://github.com/weavery/clarity.ml -k git 268 | ``` 269 | 270 | ### Running the program 271 | 272 | ```bash 273 | alias clarc='dune exec bin/clarc/clarc.exe --' 274 | 275 | clarc --help 276 | ``` 277 | 278 | ### Installing from source code 279 | 280 | ```bash 281 | git clone https://github.com/weavery/clarc.git 282 | 283 | cd clarc 284 | 285 | dune build 286 | 287 | sudo install _build/default/bin/clarc/clarc.exe /usr/local/bin/clarc 288 | ``` 289 | 290 | ## Acknowledgments 291 | 292 | We thank the [Stacks Foundation] for [sponsoring] the development of Clarc. 293 | 294 | We thank [Blockstack] and [Algorand] for having developed the Clarity language, 295 | an important evolution for the future of smart contracts. 296 | 297 | [Algorand]: https://algorand.com 298 | [AST]: https://en.wikipedia.org/wiki/Abstract_syntax_tree 299 | [Blockstack]: https://blockstack.org 300 | [Clarity]: https://clarity-lang.org 301 | [Clarity.js]: https://github.com/weavery/clarity.js 302 | [Clarity.ml]: https://github.com/weavery/clarity.ml 303 | [Ethereum]: https://ethereum.org 304 | [IR]: https://en.wikipedia.org/wiki/Intermediate_representation 305 | [MyEtherWallet]: https://www.myetherwallet.com/interface/interact-with-contract 306 | [OCaml]: https://ocaml.org 307 | [Ropsten]: https://ropsten.etherscan.io 308 | [sponsoring]: https://github.com/stacksgov/Stacks-Grants/issues/16 309 | [Stacks Foundation]: https://stacks.org 310 | 311 | [`counter.clar`]: https://github.com/weavery/clarc/blob/master/etc/examples/counter.clar 312 | [`counter.bin`]: https://gist.github.com/artob/1f08c37a55965ff486e6ca99f1ade00d 313 | [`counter.json`]: https://github.com/weavery/clarc/blob/master/etc/examples/counter.json 314 | 315 | [`kv-store.clar`]: https://github.com/weavery/clarc/blob/master/etc/examples/kv-store.clar 316 | [`kv-store.bin`]: https://gist.github.com/artob/b0f176f52d6d538d7b195c2fb7f6058a 317 | [`kv-store.json`]: https://github.com/weavery/clarc/blob/master/etc/examples/kv-store.json 318 | 319 | [`panic.clar`]: https://github.com/weavery/clarc/blob/master/etc/examples/panic.clar 320 | [`panic.bin`]: https://gist.github.com/artob/945397b444402f6bea7512993608b02c 321 | [`panic.json`]: https://github.com/weavery/clarc/blob/master/etc/examples/panic.json 322 | 323 | ## Status 324 | 325 | ### Supported Clarity features 326 | 327 | Feature | Type | Status | Notes 328 | ------- | ---- | ------ | ----- 329 | `*` | function | ✅ | For two parameters. Without overflow checking. 330 | `+` | function | ✅ | For two parameters. Without overflow checking. 331 | `-` | function | ✅ | For two parameters. Without underflow checking. 332 | `/` | function | ✅ | For two parameters. Without division-by-zero checking. 333 | `<` | function | ✅ | 334 | `<=` | function | ✅ | 335 | `>` | function | ✅ | 336 | `>=` | function | ✅ | 337 | `and` | operator | ✅ | For two parameters. 338 | `append` | function | ✅ | 339 | `as-contract` | operator | 🚧 | 340 | `as-max-len?` | operator | 🚧 | 341 | `asserts!` | function | ✅ | 342 | `at-block` | operator | ❌ | Not implemented yet. 343 | `begin` | operator | 🚧 | 344 | `block-height` | keyword | ✅ | 345 | `buff` | literal | ✅ | 346 | `burn-block-height` | keyword | ✅ | 347 | `concat` | function | ✅ | Only for lists. 348 | `contract-call?` | operator | ❌ | Not implemented yet. 349 | `contract-caller` | keyword | ✅ | 350 | `contract-of` | operator | ❌ | Not implemented yet. 351 | `default-to` | function | ✅ | 352 | `err` | function | ✅ | 353 | `false` | literal | ✅ | 354 | `filter` | function | 🚧 | 355 | `fold` | function | 🚧 | 356 | `ft-get-balance` | function | 🚧 | 357 | `ft-mint?` | function | 🚧 | 358 | `ft-transfer?` | function | 🚧 | 359 | `get` | operator | 🚧 | 360 | `get-block-info?` | operator | ❌ | Not implemented yet. 361 | `hash160` | function | ✅ | 362 | `if` | operator | ✅ | 363 | `impl-trait` | operator | ❌ | Not implemented yet. 364 | `int` | literal | ✅ | 365 | `is-eq` | function | ✅ | For two parameters. 366 | `is-err` | function | ✅ | 367 | `is-in-regtest` | keyword | ✅ | 368 | `is-none` | function | ✅ | 369 | `is-ok` | function | ✅ | 370 | `is-some` | function | ✅ | 371 | `keccak256` | function | ✅ | 372 | `len` | function | ✅ | Only for literals. 373 | `let` | operator | 🚧 | 374 | `list` | function | ✅ | 375 | `map` | function | 🚧 | 376 | `map-delete` | function | 🚧 | 377 | `map-get?` | function | ✅ | 378 | `map-insert` | function | 🚧 | 379 | `map-set` | function | 🚧 | 380 | `match` | operator | ✅ | 381 | `mod` | function | ✅ | Without division-by-zero checking. 382 | `nft-get-owner?` | function | 🚧 | 383 | `nft-mint?` | function | 🚧 | 384 | `nft-transfer?` | function | 🚧 | 385 | `none` | literal | ✅ | 386 | `not` | function | ✅ | 387 | `ok` | function | ✅ | 388 | `or` | operator | ✅ | For two parameters. 389 | `pow` | function | ✅ | Without overflow checking. 390 | `principal` | literal | 🚧 | 391 | `principal-of?` | function | 🚧 | 392 | `print` | function | ✅ | Only for literals. Without a meaningful return value. 393 | `secp256k1-recover?` | function | ❌ | Not implemented yet. 394 | `secp256k1-verify` | function | ❌ | Not implemented yet. 395 | `sha256` | function | ✅ | 396 | `sha512` | function | ❌ | Not implemented yet. 397 | `sha512/256` | function | ❌ | Not implemented yet. 398 | `some` | function | ✅ | 399 | `sqrti` | function | ❌ | Not implemented yet. 400 | `string` | literal | ✅ | 401 | `stx-burn?` | function | ❌ | Not supported. 402 | `stx-get-balance` | function | ❌ | Not supported. 403 | `stx-liquid-supply` | keyword | ❌ | Not supported. 404 | `stx-transfer?` | function | ❌ | Not supported. 405 | `to-int` | function | 🚧 | 406 | `to-uint` | function | 🚧 | 407 | `true` | literal | ✅ | 408 | `try!` | function | ✅ | 409 | `tuple` | operator | 🚧 | 410 | `tx-sender` | keyword | ✅ | 411 | `uint` | literal | ✅ | 412 | `unwrap!` | function | ✅ | 413 | `unwrap-err!` | function | ✅ | 414 | `unwrap-err-panic` | function | ✅ | 415 | `unwrap-panic` | function | ✅ | 416 | `use-trait` | operator | ❌ | Not implemented yet. 417 | `var-get` | operator | ✅ | 418 | `var-set` | operator | ✅ | 419 | `xor` | function | ✅ | 420 | 421 | **Legend**: ❌ = not supported. 🚧 = work in progress. ✅ = supported. 422 | -------------------------------------------------------------------------------- /Rakefile: -------------------------------------------------------------------------------- 1 | # This is free and unencumbered software released into the public domain. 2 | 3 | require 'yaml' 4 | require 'active_support/core_ext/hash' # `gem install activesupport` 5 | 6 | def parse_examples(filepath, type) 7 | examples = {} 8 | File.open(filepath) do |file| 9 | name = nil 10 | file.readline; file.readline # skip URL 11 | file.read.split("\n\n").each do |section| 12 | case section 13 | when / \$ clarc/ 14 | examples[name][:ok] += 1 if section.include?('STOP') 15 | examples[name][:err] += 1 if section.include?('clarc:') 16 | when /^([^:]+):\s?(.*)/ 17 | examples[name = $1] = {type: type, ok: 0, err: 0, notes: $2.strip} 18 | else abort "unknown section: #{section}" 19 | end 20 | end 21 | end 22 | examples 23 | end 24 | 25 | def each_feature(&block) 26 | features = {} 27 | features.merge!(parse_examples('test/literals.t', 'literal')) 28 | features.merge!(parse_examples('test/keywords.t', 'keyword')) 29 | features.merge!(parse_examples('test/operators.t', 'operator')) 30 | features.merge!(parse_examples('test/functions.t', 'function')) 31 | #features.each { |k, v| p [k, v] }; exit 32 | features.keys.sort.each do |feature| 33 | block.call(feature, features[feature]) 34 | end 35 | end 36 | 37 | task default: %w(README.md) 38 | 39 | file "README.md" => %w(test/literals.t test/keywords.t test/operators.t test/functions.t) do |t| 40 | head = File.read(t.name).split("### Supported Clarity features\n", 2).first 41 | File.open(t.name, 'w') do |file| 42 | file.puts head 43 | file.puts "### Supported Clarity features" 44 | file.puts 45 | file.puts ["Feature", "Type", "Status", "Notes"].join(' | ') 46 | file.puts ["-------", "----", "------", "-----"].join(' | ') 47 | each_feature do |feature, feature_info| 48 | file.puts [ 49 | "`#{feature}`", 50 | feature_info[:type], 51 | feature_info[:notes] == "Not supported." || feature_info[:notes] == "Not implemented yet." ? "❌" : 52 | (feature_info[:ok] > 0 ? "✅" : "🚧"), 53 | feature_info[:notes], 54 | ].join(' | ').strip 55 | end 56 | file.puts 57 | file.puts "**Legend**: ❌ = not supported. 🚧 = work in progress. ✅ = supported." 58 | end 59 | end 60 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # To-Dos 2 | -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 0.6.0 2 | -------------------------------------------------------------------------------- /bin/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/bin/.gitkeep -------------------------------------------------------------------------------- /bin/clarc/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/bin/clarc/.gitkeep -------------------------------------------------------------------------------- /bin/clarc/Options.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | open Cmdliner 4 | 5 | let verbose = 6 | let doc = "Be verbose." in 7 | Arg.(value & flag & info ["v"; "verbose"] ~doc) 8 | 9 | let files = 10 | Arg.(value & pos_all non_dir_file ["/dev/stdin"] & info [] ~docv:"FILE") 11 | 12 | let output = 13 | let doc = "Specify the output file." in 14 | Arg.(value & opt (some string) None & info ["o"; "output"] ~docv:"OUTPUT" ~doc) 15 | 16 | let target = 17 | let output_format = 18 | let parse = Target.of_string in 19 | let print ppf p = Target.to_string p |> Format.fprintf ppf "%s" in 20 | Arg.conv ~docv:"TARGET" (parse, print) 21 | in 22 | let doc = "Specify the output format: `auto', `bytecode', `opcode'." in 23 | Arg.(value & opt output_format Target.Auto & info ["t"; "target"] ~docv:"TARGET" ~doc) 24 | 25 | let optimize = 26 | let doc = "Specify the optimization level to use." in 27 | Arg.(value & opt int 0 & info ["O"; "optimize"] ~docv:"LEVEL" ~doc) 28 | 29 | let features = 30 | let open Clar2EVM in 31 | let feature_flag = 32 | let parse = Feature.of_string in 33 | let print ppf p = Feature.to_string p |> Format.fprintf ppf "%s" in 34 | Arg.conv ~docv:"FLAG" (parse, print) 35 | in 36 | let doc = "Specify optional feature flags: `no-deploy', `only-function='." in 37 | Arg.(value & opt_all feature_flag [Feature.None] & info ["f"; "feature"] ~docv:"FLAG" ~doc) 38 | -------------------------------------------------------------------------------- /bin/clarc/Options.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val verbose : bool Cmdliner.Term.t 4 | val files : string list Cmdliner.Term.t 5 | val output : string option Cmdliner.Term.t 6 | val target : Target.t Cmdliner.Term.t 7 | val optimize : int Cmdliner.Term.t 8 | val features : Clar2EVM.Feature.t list Cmdliner.Term.t 9 | -------------------------------------------------------------------------------- /bin/clarc/Target.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | type t = 4 | | Auto 5 | | Bytecode 6 | | Opcode 7 | | Debug 8 | 9 | let of_string = function 10 | | "auto" -> Ok Auto 11 | | "bytecode" -> Ok Bytecode 12 | | "opcode" -> Ok Opcode 13 | | "debug" -> Ok Debug 14 | | _ -> Error (`Msg "invalid output format") 15 | 16 | let to_string = function 17 | | Auto -> "auto" 18 | | Bytecode -> "bytecode" 19 | | Opcode -> "opcode" 20 | | Debug -> "debug" 21 | -------------------------------------------------------------------------------- /bin/clarc/Target.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | type t = 4 | | Auto 5 | | Bytecode 6 | | Opcode 7 | | Debug 8 | 9 | val of_string : string -> (t, [ `Msg of string ]) result 10 | val to_string : t -> string 11 | -------------------------------------------------------------------------------- /bin/clarc/clarc.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | open Cmdliner 4 | 5 | let version = "0.6.0" (* TODO: preprocess from VERSION *) 6 | 7 | exception Error of int * string * string 8 | 9 | let clarc verbose paths output target _optimize features = 10 | let _fprintf = Format.fprintf in 11 | 12 | let eprintf = if Unix.isatty (Unix.descr_of_out_channel stderr) 13 | then Ocolor_format.eprintf 14 | else Format.eprintf 15 | in 16 | 17 | let output_channel = 18 | match output with None -> stdout | Some output_path -> open_out output_path 19 | in 20 | 21 | let output_formatter = Format.formatter_of_out_channel output_channel in 22 | 23 | let _printf (format : ('a, Format.formatter, unit) format) : 'a = 24 | if Unix.isatty (Unix.descr_of_out_channel output_channel) 25 | then 26 | let formatter' = Ocolor_format.make_formatter output_formatter in 27 | Format.fprintf (Ocolor_format.unwrap_formatter formatter') format 28 | else Format.fprintf output_formatter format 29 | in 30 | 31 | let read_file path = 32 | let channel = open_in path in 33 | let contents = really_input_string channel (in_channel_length channel) in 34 | close_in channel; 35 | contents 36 | in 37 | 38 | let guess_target = function 39 | | None -> None 40 | | Some output -> begin match Filename.extension output with 41 | | ".bin" -> Some Target.Bytecode 42 | | ".opcode" -> Some Target.Opcode 43 | | _ -> None 44 | end 45 | in 46 | 47 | let rec process_program program target = 48 | match target with 49 | | Target.Auto -> begin match guess_target output with 50 | | Some target -> process_program program target 51 | | None -> process_program program Bytecode 52 | end 53 | | Bytecode -> 54 | let (deployer, program) = Clar2EVM.compile_contract program ~features in 55 | let program = deployer @ program in 56 | let printf = Format.fprintf output_formatter in 57 | printf "@[%a@]@." EVM.print_program_as_bytecode program 58 | | Opcode -> 59 | let (deployer, program) = Clar2EVM.compile_contract program ~features in 60 | let program = deployer @ program in 61 | let printf = Format.fprintf output_formatter in 62 | printf "@[%a@]@." EVM.print_program_as_opcode program 63 | | Debug -> 64 | let (_, program) = Clar2EVM.compile_contract program ~features in 65 | let printf = Format.fprintf output_formatter in 66 | printf "@[%a@]@." EVM.print_debug program 67 | in 68 | 69 | let process_file path = 70 | if verbose then eprintf "@{Compiling %s...@}@." path; 71 | let input = read_file path in 72 | let program = Clarity.parse_program input in 73 | process_program program target 74 | in 75 | 76 | try `Ok (List.iter process_file paths) 77 | with Error (code, path, error) -> begin 78 | eprintf "@{error:@} %s: %s@." path error; 79 | exit code 80 | end 81 | 82 | let command = 83 | let doc = "compile Clarity contracts for Ethereum" in 84 | let man = [ 85 | `S Manpage.s_description; 86 | `P "$(tname) compiles Clarity contracts into Ethereum virtual machine (EVM) bytecode."; 87 | `S Manpage.s_bugs; `P "Report any bugs at ." ] 88 | in 89 | Term.(ret (const clarc $ Options.verbose $ Options.files $ Options.output $ Options.target $ Options.optimize $ Options.features)), 90 | Term.info "clarc" ~version ~doc ~exits:Term.default_exits ~man 91 | 92 | let () = Term.(exit @@ eval command) 93 | -------------------------------------------------------------------------------- /bin/clarc/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name clarc) 3 | (libraries Clar2EVM EVM clarity-lang cmdliner ISO8601 ocolor unix)) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | (name clarc) 3 | (version 0.6.0) 4 | (using menhir 2.0) 5 | (cram enable) 6 | -------------------------------------------------------------------------------- /dune-workspace: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | (context default) 3 | -------------------------------------------------------------------------------- /etc/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/etc/.gitkeep -------------------------------------------------------------------------------- /etc/examples/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/etc/examples/.gitkeep -------------------------------------------------------------------------------- /etc/examples/counter.clar: -------------------------------------------------------------------------------- 1 | (define-data-var counter int 0) 2 | 3 | (define-read-only (get-counter) 4 | (ok (var-get counter))) 5 | 6 | (define-public (increment) 7 | (begin 8 | (var-set counter (+ (var-get counter) 1)) 9 | (ok (var-get counter)))) 10 | 11 | (define-public (decrement) 12 | (begin 13 | (var-set counter (- (var-get counter) 1)) 14 | (ok (var-get counter)))) 15 | -------------------------------------------------------------------------------- /etc/examples/counter.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "stateMutability" : "nonpayable", 4 | "outputs" : [ 5 | { 6 | "type" : "int128", 7 | "name" : "", 8 | "internalType" : "int128" 9 | } 10 | ], 11 | "inputs" : [], 12 | "name" : "decrement", 13 | "type" : "function" 14 | }, 15 | { 16 | "stateMutability" : "view", 17 | "outputs" : [ 18 | { 19 | "internalType" : "int128", 20 | "name" : "", 21 | "type" : "int128" 22 | } 23 | ], 24 | "name" : "getCounter", 25 | "inputs" : [], 26 | "type" : "function" 27 | }, 28 | { 29 | "type" : "function", 30 | "inputs" : [], 31 | "name" : "increment", 32 | "outputs" : [ 33 | { 34 | "internalType" : "int128", 35 | "type" : "int128", 36 | "name" : "" 37 | } 38 | ], 39 | "stateMutability" : "nonpayable" 40 | } 41 | ] 42 | -------------------------------------------------------------------------------- /etc/examples/counter.sol: -------------------------------------------------------------------------------- 1 | // SPDX-License-Identifier: Unlicense 2 | 3 | pragma solidity ^0.7.0; 4 | 5 | contract Counter { 6 | int128 private count = 0; 7 | 8 | function getCounter() public view returns (int128) { 9 | return count; 10 | } 11 | 12 | function increment() public returns (int128) { 13 | count += 1; 14 | return count; 15 | } 16 | 17 | function decrement() public returns (int128) { 18 | count -= 1; 19 | return count; 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /etc/examples/kv-store.clar: -------------------------------------------------------------------------------- 1 | (define-map store ((key principal)) 2 | ((v1 int) 3 | (v2 int)) 4 | ) 5 | 6 | (define-public (get-value (key principal)) 7 | (match (map-get? store {key: key}) 8 | entry (ok (get v2 entry)) 9 | (err 0))) 10 | 11 | (define-public (set-value (key principal)) 12 | (begin 13 | (map-set store {key: tx-sender} {v1: 100, v2: 7}) 14 | (ok true))) 15 | -------------------------------------------------------------------------------- /etc/examples/kv-store.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "stateMutability" : "view", 4 | "name" : "getValue", 5 | "inputs" : [ 6 | { 7 | "internalType" : "address", 8 | "type" : "address", 9 | "name" : "key" 10 | } 11 | ], 12 | "type" : "function", 13 | "outputs" : [ 14 | { 15 | "internalType" : "int128", 16 | "name" : "", 17 | "type" : "int128" 18 | } 19 | ] 20 | }, 21 | { 22 | "outputs" : [ 23 | { 24 | "internalType" : "bool", 25 | "type" : "bool", 26 | "name" : "" 27 | } 28 | ], 29 | "stateMutability" : "nonpayable", 30 | "name" : "setValue", 31 | "inputs" : [ 32 | { 33 | "name" : "key", 34 | "type" : "address", 35 | "internalType" : "address" 36 | } 37 | ], 38 | "type" : "function" 39 | } 40 | ] 41 | -------------------------------------------------------------------------------- /etc/examples/kv-store.sol: -------------------------------------------------------------------------------- 1 | // SPDX-License-Identifier: Unlicense 2 | 3 | pragma solidity ^0.7.0; 4 | 5 | contract KvStore { 6 | mapping(address => int256) private store; 7 | 8 | function getValue(address key) public view returns (int128) { 9 | // TODO 10 | return 0; 11 | } 12 | 13 | function setValue(address key) public returns (bool) { 14 | // TODO 15 | return true; 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /etc/examples/panic.clar: -------------------------------------------------------------------------------- 1 | 2 | (define-data-var trigger (optional uint) none) 3 | 4 | (define-private (panic-private) 5 | (unwrap-panic (var-get trigger)) 6 | ) 7 | 8 | (define-read-only (panic-read-only) 9 | (ok (panic-private)) 10 | ) 11 | 12 | (define-public (panic) 13 | (ok (panic-private)) 14 | ) 15 | -------------------------------------------------------------------------------- /etc/examples/panic.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "name" : "panic", 4 | "type" : "function", 5 | "inputs" : [], 6 | "outputs" : [], 7 | "stateMutability" : "nonpayable" 8 | }, 9 | { 10 | "stateMutability" : "view", 11 | "outputs" : [], 12 | "inputs" : [], 13 | "type" : "function", 14 | "name" : "panicReadOnly" 15 | } 16 | ] 17 | -------------------------------------------------------------------------------- /etc/examples/panic.sol: -------------------------------------------------------------------------------- 1 | // SPDX-License-Identifier: Unlicense 2 | 3 | pragma solidity ^0.7.0; 4 | 5 | contract Panic { 6 | uint128 private trigger = 0; 7 | 8 | function panicPrivate() private view { 9 | // TODO 10 | } 11 | 12 | function panicReadOnly() public view { 13 | panicPrivate(); 14 | } 15 | 16 | function panic() public { 17 | panicPrivate(); 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /etc/flowchart.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/etc/flowchart.png -------------------------------------------------------------------------------- /etc/manpage.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/etc/manpage.jpg -------------------------------------------------------------------------------- /etc/mew-deploy.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/etc/mew-deploy.jpg -------------------------------------------------------------------------------- /lib/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/lib/.gitkeep -------------------------------------------------------------------------------- /lib/Clar2EVM/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/lib/Clar2EVM/.gitkeep -------------------------------------------------------------------------------- /lib/Clar2EVM/Clar2EVM.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | #include "features.ml" 4 | #include "utility.ml" 5 | #include "typecheck.ml" 6 | #include "compile.ml" 7 | -------------------------------------------------------------------------------- /lib/Clar2EVM/Clar2EVM.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | #include "features.mli" 4 | #include "utility.mli" 5 | #include "typecheck.mli" 6 | #include "compile.mli" 7 | -------------------------------------------------------------------------------- /lib/Clar2EVM/compile.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | type context = 4 | { global_vars: string list; 5 | global_funs: string list; 6 | local_vars: (string * int) list; } 7 | 8 | let make_context global_vars global_funs local_vars = 9 | { global_vars; global_funs; local_vars; } 10 | 11 | let extend_context context local_vars = 12 | { global_vars = context.global_vars; 13 | global_funs = context.global_funs; 14 | local_vars = local_vars @ context.local_vars; } 15 | 16 | let _dump_context context = 17 | let dump_local_var (n, i) = Printf.eprintf "\t(%s, %d)" n i in 18 | Printf.eprintf "local_vars=%d\t" (List.length context.local_vars); 19 | List.iter dump_local_var context.local_vars 20 | 21 | let unimplemented_function name type' = 22 | unimplemented (Printf.sprintf "(%s %s)" name (Clarity.type_to_string type')) 23 | 24 | let unsupported_function name type' = 25 | unsupported (Printf.sprintf "(%s %s)" name (Clarity.type_to_string type')) 26 | 27 | let unsupported_function2 name type1 type2 = 28 | let typename1 = Clarity.type_to_string type1 in 29 | let typename2 = Clarity.type_to_string type2 in 30 | unsupported (Printf.sprintf "(%s %s %s)" name typename1 typename2) 31 | 32 | let error_in_function name message = 33 | failwith (Printf.sprintf "%s: %s" name message) 34 | 35 | let rec compile_contract ?(features=[]) program = 36 | let only_f = function Feature.OnlyFunction fn -> Some fn | _ -> None in 37 | let only_function = List.find_map only_f features in 38 | let no_deploy = 39 | match only_function with 40 | | Some _ -> true 41 | | None -> List.memq Feature.NoDeploy features 42 | in 43 | let is_var = function 44 | | Clarity.Constant _ | DataVar _ | Map _ -> true 45 | | _ -> false 46 | in 47 | let name_of = function 48 | | Clarity.Constant (name, _) 49 | | DataVar (name, _, _) 50 | | Map (name, _, _) 51 | | PrivateFunction (name, _, _) 52 | | PublicFunction (name, _, _) 53 | | PublicReadOnlyFunction (name, _, _) -> name 54 | in 55 | let (vars, funs) = List.partition is_var program in 56 | match only_function with 57 | | Some fn -> 58 | let funs = funs |> List.filter (fun f -> fn = name_of f) in 59 | let globals = make_context (List.map name_of vars) (List.map name_of funs) [] in 60 | let program = compile_program features globals funs in 61 | let payload = link_program program in 62 | ([], payload) 63 | | None -> 64 | let globals = make_context (List.map name_of vars) (List.map name_of funs) [] in 65 | let dispatcher = compile_dispatcher funs in 66 | let program = compile_program features globals funs in 67 | let payload = link_program (dispatcher @ program) in 68 | let deployer = if no_deploy then [] else compile_deployer globals vars payload in 69 | (deployer, payload) 70 | 71 | and compile_deployer env vars payload = 72 | let inits = List.concat (List.mapi (compile_var env) vars) in 73 | let loader_length = 11 in (* keep in sync with bytecode below *) 74 | let loader = [ 75 | EVM.from_int (EVM.program_size payload); 76 | EVM.DUP 1; 77 | EVM.from_int (loader_length + (EVM.opcodes_size inits)); 78 | EVM.zero; 79 | EVM.CODECOPY; 80 | EVM.zero; (* offset = memory address 0 *) 81 | EVM.RETURN; (* RETURN offset, length *) 82 | ] in 83 | [(0, inits @ loader)] 84 | 85 | and compile_var env index = function 86 | | Clarity.Constant _ -> 87 | unimplemented "define-constant" (* TODO *) 88 | | DataVar (_name, _type', value) -> 89 | let value = compile_expression env value in 90 | EVM.sstore index value 91 | | Map (_name, _, _) -> 92 | let value = [EVM.zero] in (* TODO: store the byte size of the value tuple? *) 93 | EVM.sstore index value 94 | | _ -> unreachable () 95 | 96 | and compile_dispatcher program = 97 | let prelude = [ 98 | EVM.from_int 0xE0; (* b = 224 *) 99 | EVM.from_int 0x02; (* a = 2 *) 100 | EVM.EXP; (* EXP a, b (2^224) *) 101 | EVM.zero; (* i = 0 *) 102 | EVM.CALLDATALOAD; (* CALLDATALOAD i *) 103 | EVM.DIV; (* DIV a, b *) 104 | ] in 105 | let tests = List.concat (List.mapi compile_dispatcher_test program) in 106 | let postlude = EVM.stop in 107 | [(0, prelude @ tests @ postlude)] 108 | 109 | and compile_dispatcher_test index = function 110 | | Clarity.Constant _ | DataVar _ | Map _ -> unreachable () 111 | | PrivateFunction _ -> [] 112 | | PublicFunction (name, params, _) 113 | | PublicReadOnlyFunction (name, params, _) -> 114 | let hash = function_hash name params in 115 | let dest = 1 + index in 116 | [ 117 | EVM.DUP 1; (* b = top of stack *) 118 | EVM.PUSH (4, hash); (* a = keccak256(function_sig)[:4] *) 119 | EVM.EQ; (* cond = EQ a, b *) 120 | EVM.from_int dest; (* dest = the function prelude *) 121 | EVM.JUMPI; (* JUMPI dest, cond *) 122 | ] 123 | 124 | and compile_program features env program = 125 | List.mapi (compile_definition features env) program 126 | 127 | and compile_definition features env index = function 128 | | Clarity.Constant _ | DataVar _ | Map _ -> unreachable () 129 | | PrivateFunction func -> compile_private_function features env index func 130 | | PublicFunction func -> compile_public_function features env index func ~response_only:true 131 | | PublicReadOnlyFunction func -> compile_public_function features env index func ~response_only:false 132 | 133 | and compile_public_function ?(response_only=false) features env index (name, _, body) = 134 | let only_f = function Feature.OnlyFunction fn -> Some fn | _ -> None in 135 | let only_function = List.find_map only_f features in 136 | let prelude = 137 | match only_function with 138 | | Some _ -> [] 139 | | None -> [ 140 | EVM.JUMPDEST; (* the contract dispatcher will jump here *) 141 | EVM.POP; (* clean up from the dispatcher logic *) 142 | (* TODO: fetch function arguments *) 143 | ] 144 | in 145 | let rec compile_body_with_response_return = function 146 | | [] -> error_in_function name "function body is empty" 147 | | [Clarity.Ok expr] 148 | | [Clarity.Err expr] -> [compile_expression env expr] 149 | | [expr] -> 150 | begin match type_of_expression expr with 151 | | Response _ -> [compile_expression env expr] 152 | | _ -> error_in_function name "function must return (ok) or (err)" 153 | end 154 | | expr :: exprs -> compile_expression env expr :: compile_body_with_response_return exprs 155 | in 156 | let compile_body_with_any_return = function 157 | | [] -> error_in_function name "function body is empty" 158 | | exprs -> List.map (compile_expression env) exprs 159 | in 160 | let compile_body = if response_only 161 | then compile_body_with_response_return 162 | else compile_body_with_any_return 163 | in 164 | let body = compile_body body |> List.concat in 165 | let postlude = (* (ok ...) or (err ...) expected on top of stack *) 166 | EVM.mstore 0 [] 167 | @ EVM.return1 168 | @ EVM.stop (* redundant, but a good marker for EOF *) 169 | in 170 | (1 + index, prelude @ body @ postlude) 171 | 172 | and compile_private_function _features env index (_, _, body) = 173 | let prelude = EVM.jumpdest in (* the calling function will jump here, with the return PC on TOS *) 174 | let body = List.concat_map (compile_expression env) body in 175 | let postlude = [ (* return value expected on top of stack *) 176 | EVM.SWAP 1; (* destination, result -- result, destination *) 177 | EVM.JUMP; (* JUMP destination *) 178 | ] @ EVM.stop (* redundant, but a good marker for EOF *) 179 | in 180 | (1 + index, prelude @ body @ postlude) 181 | 182 | and compile_expression env = function 183 | | Literal lit -> compile_literal lit 184 | | TupleExpression [("key", key)] -> compile_expression env key 185 | | TupleExpression _ -> unimplemented "arbitrary tuple expressions" (* TODO *) 186 | 187 | | Add [a; b] -> 188 | let a = compile_expression env a in 189 | let b = compile_expression env b in 190 | EVM.add a b (* TODO: handle overflow *) 191 | 192 | | And [a; b] -> 193 | let a = compile_expression env a in 194 | let b = compile_expression env b in 195 | EVM.and' a b 196 | 197 | | DefaultTo (default_value, option_value) -> 198 | begin match type_of_expression option_value with 199 | | Optional _ -> 200 | let cond_value = compile_expression env option_value in 201 | let some_block = [] in (* top of stack contains the unpacked value *) 202 | let none_block = compile_expression env default_value in 203 | compile_branch cond_value some_block none_block 204 | | t -> unsupported_function "default-to" t 205 | end 206 | 207 | | Div [a; b] -> 208 | let a = compile_expression env a in 209 | let b = compile_expression env b in 210 | EVM.div a b (* TODO: handle division by zero *) 211 | 212 | | Err x -> compile_expression env x @ [EVM.zero] 213 | 214 | | Ge (a, b) -> 215 | let a = compile_expression env a in 216 | let b = compile_expression env b in 217 | EVM.ge a b (* TODO: signed vs unsigned *) 218 | 219 | | Gt (a, b) -> 220 | let a = compile_expression env a in 221 | let b = compile_expression env b in 222 | EVM.gt a b (* TODO: signed vs unsigned *) 223 | 224 | | Identifier id -> (* _dump_context env; *) 225 | begin match List.find_opt (fun (name, _) -> name = id) env.local_vars with 226 | | None -> failwith (Printf.sprintf "unbound variable: %s" id) 227 | | Some (_, local_var_index) -> 228 | let stack_slot = (List.length env.local_vars) - local_var_index in 229 | EVM.dup stack_slot 230 | end 231 | 232 | | If (cond_expr, then_branch, else_branch) -> 233 | begin match type_of_expression cond_expr with 234 | | Bool -> 235 | let cond_value = compile_expression env cond_expr in 236 | let then_block = compile_expression env then_branch in 237 | let else_block = compile_expression env else_branch in 238 | compile_branch cond_value then_block else_block 239 | | t -> unsupported_function "if" t 240 | end 241 | 242 | | IsEq [a; b] -> 243 | begin match type_of_expression a, type_of_expression b with 244 | | a_type, b_type when a_type = b_type -> 245 | let a = compile_expression env a in 246 | let b = compile_expression env b in 247 | EVM.eq a b 248 | | a_type, b_type -> unsupported_function2 "is-eq" a_type b_type 249 | end 250 | 251 | | IsErr x -> 252 | begin match type_of_expression x with 253 | | Response _ -> compile_expression env x |> EVM.iszero 254 | | t -> unsupported_function "is-err" t 255 | end 256 | 257 | | IsNone x -> 258 | begin match type_of_expression x with 259 | | Optional _ -> compile_expression env x |> EVM.iszero 260 | | t -> unsupported_function "is-none" t 261 | end 262 | 263 | | IsOk x -> 264 | begin match type_of_expression x with 265 | | Response _ -> compile_expression env x @ [EVM.ISZERO; EVM.ISZERO] 266 | | t -> unsupported_function "is-ok" t 267 | end 268 | 269 | | IsSome x -> 270 | begin match type_of_expression x with 271 | | Optional _ -> compile_expression env x @ [EVM.ISZERO; EVM.ISZERO] 272 | | t -> unsupported_function "is-some" t 273 | end 274 | 275 | | Le (a, b) -> 276 | let a = compile_expression env a in 277 | let b = compile_expression env b in 278 | EVM.le a b (* TODO: signed vs unsigned *) 279 | 280 | | Len x -> 281 | begin match type_of_expression x with 282 | | String (n, _) | Buff n | List (n, _) -> [EVM.from_int n] 283 | | t -> unsupported_function "len" t 284 | end 285 | 286 | | Let (bindings, body) -> 287 | let local_var_count = List.length env.local_vars in 288 | let compile_binding_index index (name, _) = (name, local_var_count + index) in 289 | let compile_binding_expr (_, expr) = compile_expression env expr in 290 | let env = extend_context env (List.mapi compile_binding_index bindings) in 291 | let last_body_index = (List.length body) - 1 in 292 | let compile_body_expr index expr = 293 | compile_expression env expr @ 294 | if index < last_body_index then EVM.pop1 else [] 295 | in 296 | List.map compile_binding_expr bindings @ 297 | List.mapi compile_body_expr body |> List.concat 298 | 299 | | ListExpression xs -> 300 | List.concat_map (compile_expression env) xs @ [EVM.from_int (List.length xs)] 301 | 302 | | Lt (a, b) -> 303 | let a = compile_expression env a in 304 | let b = compile_expression env b in 305 | EVM.lt a b (* TODO: signed vs unsigned *) 306 | 307 | | Match (input_expr, (_, some_branch), (_, none_branch)) -> 308 | let input_value = compile_expression env input_expr in 309 | let some_block = compile_expression env some_branch in 310 | let none_block = compile_expression env none_branch in 311 | input_value @ compile_branch [EVM.ISZERO] (EVM.pop @ none_block) some_block 312 | 313 | | Mod (a, b) -> 314 | let a = compile_expression env a in 315 | let b = compile_expression env b in 316 | EVM.mod' a b (* TODO: handle division by zero *) 317 | 318 | | Mul [a; b] -> 319 | let a = compile_expression env a in 320 | let b = compile_expression env b in 321 | EVM.mul a b (* TODO: handle overflow *) 322 | 323 | | Not x -> 324 | let x = compile_expression env x in 325 | EVM.iszero x 326 | 327 | | Ok x -> compile_expression env x @ [EVM.one] 328 | 329 | | Or [a; b] -> 330 | let a = compile_expression env a in 331 | let b = compile_expression env b in 332 | EVM.or' a b 333 | 334 | | Pow (a, b) -> 335 | let a = compile_expression env a in 336 | let b = compile_expression env b in 337 | EVM.exp a b (* TODO: handle overflow *) 338 | 339 | | SomeExpression x -> compile_expression env x @ [EVM.one] 340 | 341 | | Sub [a; b] -> 342 | let a = compile_expression env a in 343 | let b = compile_expression env b in 344 | EVM.sub a b (* TODO: handle underflow *) 345 | 346 | | Try input -> 347 | begin match type_of_expression input with 348 | | Optional _ -> 349 | let cond_value = compile_expression env input in 350 | let none_block = EVM.mstore_int 0 0 @ EVM.return1 in 351 | compile_branch cond_value [] none_block 352 | | Response _ -> 353 | let cond_value = compile_expression env input in 354 | let err_block = EVM.mstore_int 0 0 @ EVM.mstore 1 [] @ EVM.return2 in 355 | compile_branch cond_value [] err_block 356 | | t -> unsupported_function "try!" t 357 | end 358 | 359 | | UnwrapErr (input, thrown_value) -> 360 | begin match type_of_expression input with 361 | | Response _ -> 362 | let cond_value = compile_expression env input in 363 | let ok_block = EVM.pop1 @ compile_expression env thrown_value @ EVM.mstore 0 [] @ EVM.return1 in 364 | compile_branch cond_value ok_block [] 365 | | t -> unsupported_function "unwrap-err!" t 366 | end 367 | 368 | | UnwrapErrPanic input -> 369 | begin match type_of_expression input with 370 | | Response _ -> 371 | let cond_value = compile_expression env input in 372 | let ok_block = EVM.pop1 @ EVM.revert0 in 373 | compile_branch cond_value ok_block [] 374 | | t -> unsupported_function "unwrap-err-panic" t 375 | end 376 | 377 | | Unwrap (input, thrown_value) -> 378 | begin match type_of_expression input with 379 | | Optional _ -> 380 | let cond_value = compile_expression env input in 381 | let none_block = compile_expression env thrown_value @ EVM.mstore 0 [] @ EVM.return1 in 382 | compile_branch cond_value [] none_block 383 | | Response _ -> 384 | let cond_value = compile_expression env input in 385 | let err_block = EVM.pop1 @ compile_expression env thrown_value @ EVM.mstore 0 [] @ EVM.return1 in 386 | compile_branch cond_value [] err_block 387 | | t -> unsupported_function "unwrap!" t 388 | end 389 | 390 | | UnwrapPanic input -> 391 | begin match type_of_expression input with 392 | | Optional _ -> 393 | let cond_value = compile_expression env input in 394 | let none_block = EVM.revert0 in 395 | compile_branch cond_value [] none_block 396 | | Response _ -> 397 | let cond_value = compile_expression env input in 398 | let err_block = EVM.pop1 @ EVM.revert0 in 399 | compile_branch cond_value [] err_block 400 | | t -> unsupported_function "unwrap-panic" t 401 | end 402 | 403 | | VarGet var -> 404 | let var_slot = lookup_variable_slot env var in 405 | EVM.sload var_slot 406 | 407 | | VarSet (var, val') -> 408 | let var_slot = lookup_variable_slot env var in 409 | let val' = compile_expression env val' in 410 | EVM.sstore var_slot val' 411 | 412 | | Xor (a, b) -> 413 | let a = compile_expression env a in 414 | let b = compile_expression env b in 415 | EVM.xor a b 416 | 417 | | Keyword "block-height" -> EVM.number 418 | | Keyword "burn-block-height" -> EVM.number 419 | | Keyword "contract-caller" -> EVM.caller 420 | | Keyword "is-in-regtest" -> compile_literal (BoolLiteral false) 421 | | Keyword "stx-liquid-supply" -> unsupported "stx-liquid-supply" 422 | | Keyword "tx-sender" -> EVM.origin 423 | 424 | | FunctionCall ("append", [list; element]) -> 425 | begin match type_of_expression list, type_of_expression element with 426 | | List (n, e1), e2 when e1 = e2 -> 427 | let list = compile_expression env list in 428 | let element = compile_expression env element in 429 | list @ EVM.pop1 @ element @ [EVM.from_int (n + 1)] 430 | | t, e -> unsupported_function2 "append" t e 431 | end 432 | 433 | | FunctionCall ("asserts!", [bool_expr; _]) -> (* TODO: thrown_value *) 434 | begin match type_of_expression bool_expr with 435 | | Bool -> 436 | let cond_value = compile_expression env bool_expr in 437 | let then_block = [EVM.one] in 438 | let else_block = EVM.revert0 in 439 | compile_branch cond_value then_block else_block 440 | | t -> unsupported_function "asserts!" t 441 | end 442 | 443 | | FunctionCall ("concat", [list1; list2]) -> 444 | begin match type_of_expression list1, type_of_expression list2 with 445 | | List (n1, e1), List (n2, e2) when e1 = e2 -> 446 | let list1 = compile_expression env list1 in 447 | let list2 = compile_expression env list2 in 448 | list1 @ EVM.pop1 @ list2 @ EVM.pop1 @ [EVM.from_int (n1 + n2)] 449 | | t1, t2 -> unsupported_function2 "concat" t1 t2 450 | end 451 | 452 | | FunctionCall ("get", [Identifier _; Identifier _]) -> (* TODO *) 453 | [ 454 | EVM.from_int 0x80; (* 128 bits *) 455 | EVM.two; EVM.EXP; EVM.MUL; (* equivalent to EVM.SHL *) 456 | EVM.from_int 0x80; (* 128 bits *) 457 | EVM.two; EVM.EXP; EVM.SWAP 1; EVM.DIV; (* equivalent to EVM.SWAP 1; EVM.SHR *) 458 | ] 459 | 460 | | FunctionCall ("hash160", [value]) -> 461 | begin match type_of_expression value with 462 | | Clarity.Buff _ | Int | Uint -> 463 | let input_size = size_of_expression value in 464 | let input_mstore = compile_mstore_of_expression env value in 465 | input_mstore @ EVM.staticcall_hash160 (0, input_size) 0 @ EVM.pop 466 | | t -> unsupported_function "hash160" t 467 | end 468 | 469 | | FunctionCall ("keccak256", [value]) -> 470 | begin match type_of_expression value with 471 | | Clarity.Buff _ | Int | Uint -> 472 | let input_size = size_of_expression value in 473 | let value = compile_expression env value in 474 | EVM.mstore 0 value @ EVM.sha3 (0, input_size) 475 | | t -> unsupported_function "keccak256" t 476 | end 477 | 478 | | FunctionCall ("map-set", [Identifier var; key; value]) -> (* TODO *) 479 | let _ = lookup_variable_slot env var in 480 | let key = compile_expression env key in 481 | let value = compile_expression env value in 482 | value @ key @ [EVM.SSTORE] 483 | 484 | | FunctionCall ("map-get?", [Identifier var; TupleExpression [("key", _key)]]) -> (* TODO *) 485 | let _ = lookup_variable_slot env var in 486 | let key = EVM.caller in (* TODO *) 487 | key @ [EVM.SLOAD; EVM.DUP 1; EVM.ISZERO; EVM.NOT] 488 | 489 | | FunctionCall ("print", [expr]) -> 490 | begin match expr with 491 | | Literal value -> compile_static_print_call value 492 | | _ -> unimplemented "print for non-literals" (* TODO *) 493 | end 494 | 495 | | FunctionCall ("sha256", [value]) -> 496 | begin match type_of_expression value with 497 | | Clarity.Buff _ | Int | Uint -> 498 | let input_size = size_of_expression value in 499 | let input_mstore = compile_mstore_of_expression env value in 500 | input_mstore @ EVM.staticcall_sha256 (0, input_size) 0 @ EVM.pop 501 | | t -> unsupported_function "sha256" t 502 | end 503 | 504 | | FunctionCall ("sha512", [value]) -> 505 | begin match type_of_expression value with 506 | | t -> unimplemented_function "sha512" t (* TODO *) 507 | end 508 | 509 | | FunctionCall ("sha512/256", [value]) -> 510 | begin match type_of_expression value with 511 | | t -> unimplemented_function "sha512/256" t (* TODO *) 512 | end 513 | 514 | | FunctionCall (name, _args) -> 515 | let block_id = lookup_function_block env name in 516 | let call_sequence = 517 | (* TODO: push function call arguments *) 518 | EVM.jump block_id 519 | in 520 | let call_length = EVM.opcodes_size call_sequence in 521 | (compile_relative_offset call_length) @ call_sequence @ EVM.jumpdest 522 | 523 | | _ -> unimplemented "arbitrary expressions" (* TODO *) 524 | 525 | and compile_static_print_call value = 526 | (* See: https://hardhat.org/hardhat-network/#console-log *) 527 | (* See: https://github.com/nomiclabs/hardhat/blob/master/packages/hardhat-core/console.sol *) 528 | let log_addr = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x6F\x6e\x73\x6F\x6c\x65\x2e\x6c\x6f\x67" in 529 | let (signature, args) = 530 | match value with 531 | (* TODO: log(address) *) 532 | | NoneLiteral -> ("log()", []) 533 | | BoolLiteral b -> ("log(bool)", [EVM.ABI.BoolVal b]) 534 | | IntLiteral z -> ("log(int)", [EVM.ABI.Int128Val z]) 535 | | UintLiteral z -> ("log(uint)", [EVM.ABI.Uint128Val z]) 536 | | BuffLiteral s -> 537 | let n = String.length s in 538 | if n > 0 && n <= 32 then (Printf.sprintf "log(bytes%d)" n, [EVM.ABI.Bytes32Val s]) 539 | else ("log(bytes)", [EVM.ABI.BytesVal s]) 540 | | StringLiteral s -> ("log(string)", [EVM.ABI.BytesVal s]) 541 | | TupleLiteral _ -> unsupported_function "print" (type_of_literal value) 542 | in 543 | let payload = EVM.ABI.encode_with_signature signature args in 544 | let payload_size = String.length payload in 545 | let mstore = EVM.mstore_bytes 0 payload in 546 | [EVM.zero] @ (* TODO: the return value *) 547 | mstore @ EVM.staticcall log_addr (0, payload_size) (0, 0) @ EVM.pop 548 | 549 | and compile_mstore_of_expression ?(offset=0) env expr = 550 | EVM.mstore offset (compile_expression env expr) 551 | 552 | and compile_branch cond_block then_block else_block = 553 | let else_block = EVM.jumpdest @ else_block in 554 | let else_length = EVM.opcodes_size else_block in 555 | let then_block = then_block @ (compile_relative_jump else_length EVM.JUMP) in 556 | let then_length = EVM.opcodes_size then_block in 557 | cond_block @ [EVM.ISZERO] @ (compile_relative_jump then_length EVM.JUMPI) @ 558 | then_block @ else_block @ EVM.jumpdest 559 | 560 | and compile_relative_jump offset jump = 561 | let offset = 5 + offset in 562 | [EVM.PC; EVM.from_int offset; EVM.ADD; jump] 563 | 564 | and compile_relative_offset offset = 565 | let offset = 4 + offset in 566 | [EVM.PC; EVM.from_int offset; EVM.ADD] 567 | 568 | and compile_literal = function 569 | | NoneLiteral -> [EVM.zero] 570 | | BoolLiteral b -> [EVM.from_bool b] 571 | | IntLiteral z -> 572 | if (Big_int.num_bits_big_int z) <= 127 then [EVM.from_big_int z] 573 | else unsupported "int underflow/overflow" 574 | | UintLiteral z -> 575 | if (Big_int.num_bits_big_int z) <= 128 then [EVM.from_big_int z] 576 | else unsupported "uint overflow" 577 | | BuffLiteral s -> 578 | if (String.length s) <= 32 then [EVM.from_string s] 579 | else unimplemented "large buff literals (32+ bytes)" (* TODO *) 580 | | StringLiteral s -> 581 | let len = String.length s in 582 | if len = 0 then [EVM.zero; EVM.zero] 583 | else if len <= 32 then [EVM.from_string s; EVM.from_int len] 584 | else unimplemented "large string literals (32+ bytes)" (* TODO *) 585 | | TupleLiteral kvs -> compile_tuple_literal kvs 586 | 587 | and compile_tuple_literal = function 588 | | [(_, (NoneLiteral as lit))] 589 | | [(_, (BoolLiteral _ as lit))] 590 | | [(_, (IntLiteral _ as lit))] 591 | | [(_, (UintLiteral _ as lit))] -> compile_literal lit 592 | | [(_, IntLiteral a); (_, IntLiteral b)] -> compile_packed_word a b 593 | | [(_, UintLiteral _a); (_, UintLiteral _b)] -> unimplemented "packed uint tuple literals" (* TODO *) 594 | | _ -> unimplemented "arbitrary tuple literals" (* TODO *) 595 | 596 | and compile_packed_word hi lo = 597 | (* [EVM.from_big_int hi; EVM.from_int 0x80; EVM.SHL; EVM.from_big_int lo; EVM.OR] *) 598 | [EVM.from_big_int hi; EVM.from_int 0x80; EVM.two; EVM.EXP; EVM.MUL; EVM.from_big_int lo; EVM.OR] 599 | 600 | and compile_param (_, type') = 601 | compile_type type' 602 | 603 | and compile_type = function 604 | (* See: https://solidity.readthedocs.io/en/develop/abi-spec.html#types *) 605 | | Clarity.Principal -> EVM.ABI.Address 606 | | Bool -> Bool 607 | | Int -> Int128 608 | | Uint -> Uint128 609 | | Buff len | String (len, _) -> BytesN len 610 | | type' -> 611 | let type_name = Clarity.type_to_string type' in 612 | let error = Printf.sprintf "unsupported public parameter type: %s" type_name in 613 | failwith error 614 | 615 | and mangle_name = function 616 | | "*" -> "mul" 617 | | "+" -> "add" 618 | | "-" -> "sub" 619 | | "/" -> "div" 620 | | "<" -> "lt" 621 | | "<=" -> "le" 622 | | ">" -> "gt" 623 | | ">=" -> "ge" 624 | | "sha512/256" -> "sha512_256" 625 | | "try!" -> "tryUnwrap" 626 | | name -> 627 | let filtered_chars = Str.regexp "[/?!]" in 628 | let name = Str.global_replace filtered_chars "" name in 629 | let words = String.split_on_char '-' name in 630 | let words = List.map String.capitalize_ascii words in 631 | String.uncapitalize_ascii (String.concat "" words) 632 | 633 | and lookup_variable_slot env symbol = 634 | match lookup_symbol env.global_vars symbol with 635 | | None -> failwith (Printf.sprintf "unknown variable: %s" symbol) 636 | | Some index -> index 637 | 638 | and lookup_function_block env symbol = 639 | match lookup_symbol env.global_funs symbol with 640 | | None -> failwith (Printf.sprintf "unknown function: %s" symbol) 641 | | Some index -> 1 + index 642 | 643 | and lookup_symbol symbols symbol = 644 | let rec loop index = function 645 | | [] -> None 646 | | hd :: tl -> 647 | if hd = symbol then Some index 648 | else loop (index + 1) tl 649 | in 650 | loop 0 symbols 651 | 652 | and link_offsets program = 653 | let rec loop pc = function 654 | | [] -> [] 655 | | (_, body) :: rest -> 656 | let next_pc = pc + EVM.opcodes_size body in 657 | pc :: loop next_pc rest 658 | in 659 | loop 0 program 660 | 661 | and link_program program = 662 | let block_offsets = link_offsets program in 663 | let rec link_block = function 664 | | [] -> [] 665 | | EVM.PUSH (1, block_id) :: (EVM.JUMP as jump) :: rest 666 | | EVM.PUSH (1, block_id) :: (EVM.JUMPI as jump) :: rest -> 667 | let block_id = String.get block_id 0 |> Char.code in 668 | let block_pc = List.nth block_offsets block_id in 669 | EVM.from_int block_pc :: jump :: link_block rest 670 | | op :: rest -> op :: link_block rest 671 | in 672 | let rec link_blocks = function 673 | | [] -> [] 674 | | (id, body) :: rest -> (id, link_block body) :: link_blocks rest 675 | in 676 | link_blocks program 677 | 678 | and function_hash name params = 679 | let name = mangle_name name in 680 | let params = List.map compile_param params in 681 | EVM.ABI.encode_function_prototype name params 682 | 683 | and size_of_expression expr = 684 | size_of_type (type_of_expression expr) 685 | 686 | and size_of_type = function 687 | | Clarity.Unit -> 0 688 | | Principal -> 20 689 | | Bool | Int | Uint -> 16 690 | | Optional t -> size_of_type t 691 | | Response (t, _) -> size_of_type t 692 | | Buff n -> n 693 | | String (n, _) -> n 694 | | List _ -> unimplemented "size_of_type for lists" (* TODO *) 695 | | Tuple _ -> unimplemented "size_of_type for tuples" (* TODO *) 696 | -------------------------------------------------------------------------------- /lib/Clar2EVM/compile.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val compile_contract : ?features:(Feature.t list) -> Clarity.program -> EVM.contract 4 | -------------------------------------------------------------------------------- /lib/Clar2EVM/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name Clar2EVM) 3 | (modules Clar2EVM) 4 | (wrapped false) 5 | (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 6 | (preprocessor_deps 7 | compile.ml 8 | compile.mli 9 | features.ml 10 | features.mli 11 | typecheck.ml 12 | typecheck.mli 13 | utility.ml 14 | utility.mli) 15 | (libraries EVM clarity-lang str)) 16 | -------------------------------------------------------------------------------- /lib/Clar2EVM/features.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | module Feature = struct 4 | type t = 5 | | None 6 | | NoDeploy 7 | | OnlyFunction of string 8 | 9 | let of_string s = 10 | match String.split_on_char '=' s with 11 | | [] -> Ok None 12 | | ["no-deploy"] -> Ok NoDeploy 13 | | ["only-function"; fn] -> Ok (OnlyFunction fn) 14 | | _ -> Error (`Msg "invalid feature flag") 15 | 16 | let to_string = function 17 | | None -> "" 18 | | NoDeploy -> "no-deploy" 19 | | OnlyFunction fn -> Printf.sprintf "only-function=%s" fn 20 | end 21 | -------------------------------------------------------------------------------- /lib/Clar2EVM/features.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | module Feature : sig 4 | type t = 5 | | None 6 | | NoDeploy 7 | | OnlyFunction of string 8 | 9 | val of_string : string -> (t, [ `Msg of string ]) result 10 | val to_string : t -> string 11 | end 12 | -------------------------------------------------------------------------------- /lib/Clar2EVM/typecheck.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let unsupported_function name type' = 4 | unsupported (Printf.sprintf "(%s %s)" name (Clarity.type_to_string type')) 5 | 6 | let unsupported_function2 name type1 type2 = 7 | let typename1 = Clarity.type_to_string type1 in 8 | let typename2 = Clarity.type_to_string type2 in 9 | unsupported (Printf.sprintf "(%s %s %s)" name typename1 typename2) 10 | 11 | let rec type_of_expression = function 12 | | Clarity.Literal lit -> type_of_literal lit 13 | | Identifier _ -> Clarity.Unit (* FIXME: unimplemented "type_of_expression for variable bindings" *) 14 | 15 | | TupleExpression _ -> unimplemented "type_of_expression for tuple expressions" 16 | | ListExpression [] -> List (0, Unit) 17 | | ListExpression xs -> List (List.length xs, type_of_expression (List.hd xs)) 18 | | SomeExpression expr -> Optional (type_of_expression expr) 19 | | Ok expr -> Response (type_of_expression expr, Unit) 20 | | Err expr -> Response (Unit, type_of_expression expr) 21 | 22 | | Add _ | Sub _ | Mul _ | Div _ | Mod _ | Pow _ | Xor _ -> Clarity.Int 23 | | Ge _ | Gt _ | Le _ | Lt _ -> Bool 24 | 25 | | And _ | Or _ | Not _ -> Bool 26 | | DefaultTo (default, _) -> type_of_expression default 27 | | If (_, then', _) -> type_of_expression then' 28 | | IsEq _ | IsNone _ | IsSome _ | IsErr _ | IsOk _ -> Bool 29 | | Len _ -> Uint 30 | | Let (_, body) -> type_of_expression (match last body with Some x -> x | None -> unreachable ()) 31 | | Match (input, (_, ok_expr), (_, err_expr)) -> 32 | begin match type_of_expression input with 33 | | Optional _ | Response _ -> 34 | begin match type_of_expression ok_expr, type_of_expression err_expr with 35 | | Response _, Response _ -> Response (Unit, Unit) (* FIXME *) 36 | | ok_type, err_type when ok_type = err_type -> Response (Unit, Unit) 37 | | ok_type, err_type -> unsupported_function2 "match" ok_type err_type 38 | end 39 | | t -> unsupported_function "match" t 40 | end 41 | | ToInt _ -> Int 42 | | ToUint _ -> Uint 43 | | Try _ -> unimplemented "type_of_expression for try!" 44 | | Unwrap (_, _) 45 | | UnwrapPanic _ 46 | | UnwrapErr (_, _) 47 | | UnwrapErrPanic _ -> unimplemented "type_of_expression for unwrap forms" 48 | | VarGet _ -> unimplemented "type_of_expression for var-get" 49 | | VarSet _ -> Bool 50 | 51 | | Keyword "block-height" -> Uint 52 | | Keyword "burn-block-height" -> Uint 53 | | Keyword "contract-caller" -> Principal 54 | | Keyword "is-in-regtest" -> Bool 55 | | Keyword "stx-liquid-supply" -> Uint 56 | | Keyword "tx-sender" -> Principal 57 | | Keyword id -> unimplemented (Printf.sprintf "type_of_expression for %s" id) 58 | 59 | | FunctionCall ("append", [list; element]) -> 60 | begin match type_of_expression list, type_of_expression element with 61 | | List (n, e1), e2 when e1 = e2 -> List (n + 1, e1) 62 | | t, e -> unsupported_function2 "append" t e 63 | end 64 | 65 | | FunctionCall ("concat", [list1; list2]) -> 66 | begin match type_of_expression list1, type_of_expression list2 with 67 | | List (n1, e1), List (n2, e2) when e1 = e2 -> List (n1 + n2, e1) 68 | | t1, t2 -> unsupported_function2 "concat" t1 t2 69 | end 70 | 71 | | FunctionCall ("get", [_; tuple]) -> type_of_expression tuple 72 | | FunctionCall ("hash160", _) -> Buff 20 73 | | FunctionCall ("keccak256", _) -> Buff 32 74 | | FunctionCall ("map-set", _) -> Bool 75 | | FunctionCall ("map-get?", _) -> Optional (Tuple []) 76 | | FunctionCall ("print", [expr]) -> type_of_expression expr 77 | | FunctionCall ("sha256", _) -> Buff 32 78 | | FunctionCall ("sha512", _) -> Buff 64 79 | | FunctionCall ("sha512/256", _) -> Buff 32 80 | | FunctionCall (id, _) -> unimplemented (Printf.sprintf "type_of_expression for '%s'" id) 81 | 82 | and type_of_literal = function 83 | | Clarity.NoneLiteral -> Clarity.Optional Unit 84 | | BoolLiteral _ -> Bool 85 | | IntLiteral _ -> Int 86 | | UintLiteral _ -> Uint 87 | | TupleLiteral kvs -> Tuple (List.map (fun (id, lit) -> (id, type_of_literal lit)) kvs) 88 | | BuffLiteral s -> Buff (String.length s) 89 | | StringLiteral s -> String (String.length s, Clarity.UTF8) 90 | -------------------------------------------------------------------------------- /lib/Clar2EVM/typecheck.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val type_of_expression : Clarity.expression -> Clarity.type' 4 | 5 | val type_of_literal : Clarity.literal -> Clarity.type' 6 | -------------------------------------------------------------------------------- /lib/Clar2EVM/utility.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let unreachable () = failwith "unreachable" 4 | 5 | let unimplemented what = 6 | let message = 7 | if what = "" then "not implemented yet" 8 | else Printf.sprintf "%s not implemented yet" what 9 | in 10 | failwith message 11 | 12 | let unsupported what = 13 | let message = 14 | if what = "" then "not supported" 15 | else Printf.sprintf "%s not supported" what 16 | in 17 | failwith message 18 | 19 | let rec last = function 20 | | [] -> None 21 | | [x] -> Some x 22 | | _ :: tl -> last tl 23 | -------------------------------------------------------------------------------- /lib/Clar2EVM/utility.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val unreachable : unit -> unit 4 | 5 | val unimplemented : string -> unit 6 | 7 | val unsupported : string -> unit 8 | 9 | val last : 'a list -> 'a option 10 | -------------------------------------------------------------------------------- /lib/EVM/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/lib/EVM/.gitkeep -------------------------------------------------------------------------------- /lib/EVM/EVM.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | #include "utility.ml" 4 | #include "opcodes.ml" 5 | #include "abi.ml" 6 | #include "construct.ml" 7 | #include "metrics.ml" 8 | #include "decode.ml" 9 | #include "encode.ml" 10 | #include "print.ml" 11 | #include "debug.ml" 12 | -------------------------------------------------------------------------------- /lib/EVM/EVM.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | #include "utility.mli" 4 | #include "opcodes.ml" 5 | #include "abi.mli" 6 | #include "construct.mli" 7 | #include "metrics.mli" 8 | #include "decode.mli" 9 | #include "encode.mli" 10 | #include "print.mli" 11 | #include "debug.mli" 12 | -------------------------------------------------------------------------------- /lib/EVM/abi.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | module ABI = struct 4 | type type' = 5 | | Address 6 | | Bool 7 | | Bytes32 8 | | BytesN of int 9 | | Bytes 10 | | Int128 11 | | Int256 12 | | Uint128 13 | | Uint256 14 | 15 | type word = 16 | | AddressVal of string 17 | | BoolVal of bool 18 | | Bytes32Val of string 19 | | BytesNVal of int * string 20 | | BytesVal of string 21 | | IntVal of int 22 | | Int128Val of Big_int.big_int 23 | | Int256Val of Big_int.big_int 24 | | UintVal of int 25 | | Uint128Val of Big_int.big_int 26 | | Uint256Val of Big_int.big_int 27 | 28 | let type_of = function 29 | | AddressVal _ -> Address 30 | | BoolVal _ -> Bool 31 | | Bytes32Val _ -> Bytes32 32 | | BytesNVal (n, _) -> BytesN n 33 | | BytesVal _ -> Bytes 34 | | IntVal _ -> Int256 35 | | Int128Val _ -> Int128 36 | | Int256Val _ -> Int256 37 | | UintVal _ -> Uint256 38 | | Uint128Val _ -> Uint128 39 | | Uint256Val _ -> Uint256 40 | 41 | and type_to_string = function 42 | | Address -> "address" 43 | | Bool -> "bool" 44 | | Bytes32 -> "bytes32" 45 | | BytesN n -> Printf.sprintf "bytes%d" n 46 | | Bytes -> "bytes" 47 | | Int128 -> "int128" 48 | | Int256 -> "int256" 49 | | Uint128 -> "uint128" 50 | | Uint256 -> "uint256" 51 | 52 | let keccak256 input = 53 | let hash_function = Cryptokit.Hash.keccak 256 in 54 | Cryptokit.hash_string hash_function input 55 | 56 | let rec encode_with_signature signature args = 57 | let selector = encode_function_signature signature in 58 | encode_with_selector selector args 59 | 60 | and encode_with_selector selector args = 61 | let buffer = Buffer.create 32 in 62 | Buffer.add_string buffer selector; 63 | let append_arg arg = Buffer.add_string buffer (encode_parameter arg) in 64 | List.iter append_arg args; 65 | Buffer.contents buffer 66 | 67 | and encode_function_prototype name params = 68 | let params = String.concat "," (List.map type_to_string params) in 69 | let signature = Printf.sprintf "%s(%s)" name params in 70 | encode_function_signature signature 71 | 72 | and encode_function_signature signature = 73 | String.sub (keccak256 signature) 0 4 74 | 75 | and encode_parameter = function 76 | | AddressVal s -> encode_address_as_bytes32 s 77 | | BoolVal b -> encode_int_as_uint256 (if b then 1 else 0) 78 | | Bytes32Val s -> encode_string_as_bytes32 s 79 | | BytesNVal (_, s) -> encode_string_as_bytes32 s 80 | | BytesVal s -> encode_string_as_bytes s 81 | | IntVal z | UintVal z -> encode_int_as_uint256 z 82 | | Int128Val z | Uint128Val z -> encode_bigint_as_uint256 z 83 | | Int256Val z | Uint256Val z -> encode_bigint_as_uint256 z 84 | 85 | and encode_address_as_bytes32 address = 86 | begin match String.length address with 87 | | 20 -> 88 | let buffer = Buffer.create 32 in 89 | for _ = 1 to 12 do Buffer.add_char buffer '\x00' done; 90 | Buffer.add_string buffer address; 91 | Buffer.contents buffer 92 | | _ -> failwith "invalid address" 93 | end 94 | 95 | and encode_string_as_bytes32 input = 96 | begin match String.length input with 97 | | 32 -> input 98 | | length when length > 32 -> failwith "invalid inline string" 99 | | length -> 100 | let buffer = Buffer.create 32 in 101 | Buffer.add_string buffer input; 102 | for _ = length + 1 to 32 do Buffer.add_char buffer '\x00' done; 103 | Buffer.contents buffer 104 | end 105 | 106 | and encode_string_as_bytes input = 107 | let length = String.length input in 108 | let buffer = Buffer.create 64 in 109 | Buffer.add_int64_be buffer 0L; 110 | Buffer.add_int64_be buffer 0L; 111 | Buffer.add_int64_be buffer 0L; 112 | Buffer.add_int64_be buffer (Int64.of_int length); 113 | Buffer.add_string buffer input; 114 | for _ = length + 1 to 32 do Buffer.add_char buffer '\x00' done; 115 | Buffer.contents buffer 116 | 117 | and encode_int_as_uint256 z = 118 | encode_int64_as_uint256 (Int64.of_int z) 119 | 120 | and encode_int32_as_uint256 z = 121 | encode_int64_as_uint256 (Int64.of_int32 z) 122 | 123 | and encode_int64_as_uint256 z = 124 | let buffer = Buffer.create 32 in 125 | Buffer.add_int64_be buffer 0L; 126 | Buffer.add_int64_be buffer 0L; 127 | Buffer.add_int64_be buffer 0L; 128 | Buffer.add_int64_be buffer z; 129 | Buffer.contents buffer 130 | 131 | and encode_bigint_as_uint256 z = 132 | match Big_int.int64_of_big_int_opt z with 133 | | Some z -> encode_int64_as_uint256 z 134 | | None -> unimplemented "" (* TODO *) 135 | end 136 | -------------------------------------------------------------------------------- /lib/EVM/abi.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | (* See: https://docs.soliditylang.org/en/develop/abi-spec.html *) 4 | (* See: https://docs.soliditylang.org/en/develop/types.html *) 5 | module ABI : sig 6 | type type' = 7 | | Address 8 | | Bool 9 | | Bytes32 10 | | BytesN of int 11 | | Bytes 12 | | Int128 13 | | Int256 14 | | Uint128 15 | | Uint256 16 | 17 | type word = 18 | | AddressVal of string 19 | | BoolVal of bool 20 | | Bytes32Val of string 21 | | BytesNVal of int * string 22 | | BytesVal of string 23 | | IntVal of int 24 | | Int128Val of Big_int.big_int 25 | | Int256Val of Big_int.big_int 26 | | UintVal of int 27 | | Uint128Val of Big_int.big_int 28 | | Uint256Val of Big_int.big_int 29 | 30 | val type_of : word -> type' 31 | val type_to_string : type' -> string 32 | 33 | val encode_with_signature : string -> word list -> string 34 | val encode_with_selector : string -> word list -> string 35 | val encode_function_prototype : string -> type' list -> string 36 | val encode_function_signature : string -> string 37 | val encode_parameter : word -> string 38 | val encode_address_as_bytes32 : string -> string 39 | val encode_string_as_bytes32 : string -> string 40 | val encode_int_as_uint256 : int -> string 41 | val encode_int32_as_uint256 : int32 -> string 42 | val encode_int64_as_uint256 : int64 -> string 43 | val encode_bigint_as_uint256 : Big_int.big_int -> string 44 | end 45 | -------------------------------------------------------------------------------- /lib/EVM/construct.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | type addr = string 4 | 5 | type ptr = int 6 | 7 | type slice = ptr * int 8 | 9 | let rec addr_of_int z = 10 | match from_int z with PUSH (_, s) -> s | _ -> unreachable () 11 | 12 | and ptr_of_int z = z 13 | 14 | and from_string = function 15 | | s when String.length s <= 32 -> PUSH (String.length s, s) 16 | | _ -> unimplemented "" (* TODO *) 17 | 18 | and from_big_int z = 19 | match Big_int.int_of_big_int_opt z with 20 | | Some z -> from_int z 21 | | None -> PUSH (32, ABI.encode_bigint_as_uint256 z) 22 | 23 | and from_int z = 24 | if z < 0 then unimplemented "encoding of negative integers" (* FIXME *) 25 | else if z <= 0xFF then PUSH (1, Char.chr z |> String.make 1) 26 | else PUSH (32, ABI.encode_int_as_uint256 z) 27 | 28 | and from_bool b = from_int (if b then 1 else 0) 29 | 30 | and from_ptr = function 31 | | ptr -> from_int ptr 32 | 33 | and bytes32 s = 34 | match String.length s with 35 | | n when n = 32 -> PUSH (n, s) 36 | | n when n > 0 && n < 32 -> 37 | let buffer = Buffer.create 32 in 38 | Buffer.add_string buffer s; 39 | for _ = n + 1 to 32 do Buffer.add_char buffer '\x00' done; 40 | PUSH (32, Buffer.contents buffer) 41 | | _ -> unreachable () 42 | 43 | let from_addr = from_string 44 | 45 | let zero = from_int 0 46 | 47 | let one = from_int 1 48 | 49 | let two = from_int 2 50 | 51 | let add a b = b @ a @ [ADD] 52 | 53 | let and' a b = b @ a @ [AND] 54 | 55 | let caller = [CALLER] 56 | 57 | let div a b = b @ a @ [DIV] 58 | 59 | let dup n = [DUP n] 60 | 61 | let dup1 = dup 1 62 | 63 | let eq a b = b @ a @ [EQ] 64 | 65 | let exp a b = b @ a @ [EXP] 66 | 67 | let ge a b = b @ a @ [DUP 2; DUP 2; GT; SWAP 2; SWAP 1; EQ; OR] 68 | 69 | let gt a b = b @ a @ [GT] 70 | 71 | let iszero x = x @ [ISZERO] 72 | 73 | let jump dest = [from_int dest; JUMP] 74 | 75 | let jumpdest = [JUMPDEST] 76 | 77 | let le a b = b @ a @ [DUP 2; DUP 2; LT; SWAP 2; SWAP 1; EQ; OR] 78 | 79 | let lt a b = b @ a @ [LT] 80 | 81 | let mload ptr = [from_ptr ptr; MLOAD] 82 | 83 | let mod' a b = b @ a @ [MOD] 84 | 85 | let mstore ptr val' = val' @ [from_ptr ptr; MSTORE] 86 | 87 | let mstore_int ptr input = mstore ptr [from_int input] 88 | 89 | let mstore_bytes ptr input = 90 | let input_size = String.length input in 91 | let rec loop ptr offset result = 92 | if offset >= input_size then result 93 | else begin 94 | let length = min (input_size - offset) 32 in 95 | let word = bytes32 (String.sub input offset length) in 96 | loop (ptr + 1) (offset + 32) ([word; from_ptr ptr; MSTORE] :: result) 97 | end 98 | in 99 | loop ptr 0 [] |> List.rev |> List.concat 100 | 101 | let mul a b = b @ a @ [MUL] 102 | 103 | let not' x = x @ [NOT] 104 | 105 | let number = [NUMBER] 106 | 107 | let or' a b = b @ a @ [OR] 108 | 109 | let origin = [ORIGIN] 110 | 111 | let pop = [POP] 112 | 113 | let pop1 = pop 114 | let pop2 = [POP; POP] 115 | 116 | let return' = function 117 | | data_ptr, data_size when data_ptr = data_size -> [from_int data_size; DUP 1; RETURN] 118 | | data_ptr, data_size -> [from_int data_size; from_int data_ptr; RETURN] 119 | 120 | let return0 = return' (0, 0) 121 | let return1 = return' (0, 32) 122 | let return2 = return' (0, 64) 123 | 124 | let revert = function 125 | | data_ptr, data_size when data_ptr = data_size -> [from_int data_size; DUP 1; REVERT] 126 | | data_ptr, data_size -> [from_int data_size; from_int data_ptr; REVERT] 127 | 128 | let revert0 = revert (0, 0) 129 | let revert1 = revert (0, 32) 130 | let revert2 = revert (0, 64) 131 | 132 | let sha3 = function 133 | | input_ptr, input_size -> [from_int input_size; from_int input_ptr; SHA3] 134 | 135 | let sload key = [from_int key; SLOAD] 136 | 137 | let sstore key val' = val' @ [from_int key; SSTORE] 138 | 139 | let staticcall ?(gas=0) addr (input_ptr, input_size) (output_ptr, output_size) = 140 | [ 141 | from_int output_size; 142 | from_ptr output_ptr; 143 | from_int input_size; 144 | from_ptr input_ptr; 145 | from_addr addr; 146 | if gas > 0 then from_int gas else GAS; 147 | STATICCALL (* gas, addr, argsOffset, argsLength, retOffset, retLength *) 148 | ] 149 | 150 | let staticcall_hash160 (input_ptr, input_size) output_ptr = 151 | staticcall (addr_of_int 0x03) (input_ptr, input_size) (output_ptr, 32) 152 | 153 | let staticcall_sha256 (input_ptr, input_size) output_ptr = 154 | staticcall (addr_of_int 0x02) (input_ptr, input_size) (output_ptr, 32) 155 | 156 | let stop = [STOP] 157 | 158 | let sub a b = b @ a @ [SUB] 159 | 160 | let xor a b = b @ a @ [XOR] 161 | -------------------------------------------------------------------------------- /lib/EVM/construct.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | type addr = string 4 | 5 | type ptr = int 6 | 7 | type slice = ptr * int 8 | 9 | val addr_of_int : int -> addr 10 | 11 | val ptr_of_int : int -> ptr 12 | 13 | val zero : opcode 14 | 15 | val one : opcode 16 | 17 | val two : opcode 18 | 19 | val from_big_int : Big_int.big_int -> opcode 20 | 21 | val from_bool : bool -> opcode 22 | 23 | val from_int : int -> opcode 24 | 25 | val from_string : string -> opcode 26 | 27 | val from_addr : addr -> opcode 28 | 29 | val from_ptr : ptr -> opcode 30 | 31 | val bytes32 : string -> opcode 32 | 33 | val add : opcode list -> opcode list -> opcode list 34 | 35 | val and' : opcode list -> opcode list -> opcode list 36 | 37 | val caller : opcode list 38 | 39 | val div : opcode list -> opcode list -> opcode list 40 | 41 | val dup : int -> opcode list 42 | val dup1 : opcode list 43 | 44 | val eq : opcode list -> opcode list -> opcode list 45 | 46 | val exp : opcode list -> opcode list -> opcode list 47 | 48 | val ge : opcode list -> opcode list -> opcode list 49 | 50 | val gt : opcode list -> opcode list -> opcode list 51 | 52 | val iszero : opcode list -> opcode list 53 | 54 | val jump : int -> opcode list 55 | 56 | val jumpdest : opcode list 57 | 58 | val le : opcode list -> opcode list -> opcode list 59 | 60 | val lt : opcode list -> opcode list -> opcode list 61 | 62 | val mload : ptr -> opcode list 63 | 64 | val mod' : opcode list -> opcode list -> opcode list 65 | 66 | val mstore : ptr -> opcode list -> opcode list 67 | val mstore_int : ptr -> int -> opcode list 68 | val mstore_bytes : ptr -> string -> opcode list 69 | 70 | val mul : opcode list -> opcode list -> opcode list 71 | 72 | val not' : opcode list -> opcode list 73 | 74 | val number : opcode list 75 | 76 | val or' : opcode list -> opcode list -> opcode list 77 | 78 | val origin : opcode list 79 | 80 | val pop : opcode list 81 | val pop1 : opcode list 82 | val pop2 : opcode list 83 | 84 | val return' : slice -> opcode list 85 | val return0 : opcode list 86 | val return1 : opcode list 87 | val return2 : opcode list 88 | 89 | val revert : slice -> opcode list 90 | val revert0 : opcode list 91 | val revert1 : opcode list 92 | val revert2 : opcode list 93 | 94 | val sha3 : slice -> opcode list 95 | 96 | val sload : int -> opcode list 97 | 98 | val sstore : int -> opcode list -> opcode list 99 | 100 | val staticcall : ?gas:int -> addr -> slice -> slice -> opcode list 101 | val staticcall_hash160 : slice -> ptr -> opcode list 102 | val staticcall_sha256 : slice -> ptr -> opcode list 103 | 104 | val stop : opcode list 105 | 106 | val sub : opcode list -> opcode list -> opcode list 107 | 108 | val xor : opcode list -> opcode list -> opcode list 109 | -------------------------------------------------------------------------------- /lib/EVM/debug.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let print_debug ppf program = 4 | let open Format in 5 | let jumpdest_to_block jumpdest_pc = 6 | let rec loop pc = function 7 | | [] -> None 8 | | block :: _ when pc = jumpdest_pc -> Some block 9 | | (_, block_body) :: blocks -> 10 | loop (pc + opcodes_size block_body) blocks 11 | in 12 | loop 0 program 13 | in 14 | let print_op pc = function 15 | | PUSH (1, byte_value) as op -> 16 | let decimal_value = Char.code (String.get byte_value 0) in 17 | fprintf ppf "%04x: %s (%d)\n" pc (to_string op) decimal_value 18 | (* TODO: | PUSH (n, _) *) 19 | | op -> fprintf ppf "%04x: %s\n" pc (to_string op) 20 | in 21 | let print_push_jumpdest pc op = 22 | match jumpdest_to_block pc with 23 | | None -> fprintf ppf "%04x: %s (?)\n" pc (to_string op) 24 | | Some (block_id, _) -> fprintf ppf "%04x: %s (#%d)\n" pc (to_string op) block_id 25 | in 26 | let rec dump_block pc = function 27 | | [] -> () 28 | | (block_id, block_body) :: blocks -> 29 | let rec dump_opcode pc = function 30 | | [] -> pc 31 | | (PUSH (1, jumpdest) as op1) :: (JUMPI as op2) :: ops -> 32 | let jumpdest_pc = Char.code (String.get jumpdest 0) in 33 | print_push_jumpdest jumpdest_pc op1; 34 | let pc = pc + (opcode_size op1) in 35 | print_op pc op2; 36 | let pc = pc + (opcode_size op2) in 37 | dump_opcode pc ops 38 | (* TODO: | PUSH (n, _) *) 39 | | op :: ops -> 40 | print_op pc op; 41 | let pc = pc + (opcode_size op) in 42 | dump_opcode pc ops 43 | in 44 | fprintf ppf "#%d\n" block_id; 45 | let pc = dump_opcode pc block_body in 46 | dump_block pc blocks 47 | in 48 | dump_block 0 program 49 | -------------------------------------------------------------------------------- /lib/EVM/debug.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val print_debug : Format.formatter -> program -> unit 4 | -------------------------------------------------------------------------------- /lib/EVM/decode.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let rec decode input = 4 | let length = String.length input in 5 | let rec decode_loop index = 6 | if index = length then [] 7 | else begin 8 | let byte = String.get input index |> Char.code in 9 | let (pc', op) = match decode_opcode byte with 10 | | PUSH (n, _) -> (1 + n, PUSH (n, (String.sub input (index + 1) n))) 11 | | op -> (1, op) 12 | in 13 | [op] @ decode_loop (index + pc') 14 | end 15 | in 16 | [(0, decode_loop 0)] (* FIXME *) 17 | 18 | and decode_opcodes input = 19 | match decode input with [(_, ops)] -> ops | _ -> [] (* FIXME *) 20 | 21 | and decode_opcode = function 22 | | 0x00 -> STOP 23 | | 0x01 -> ADD 24 | | 0x02 -> MUL 25 | | 0x03 -> SUB 26 | | 0x04 -> DIV 27 | | 0x05 -> SDIV 28 | | 0x06 -> MOD 29 | | 0x07 -> SMOD 30 | | 0x08 -> ADDMOD 31 | | 0x09 -> MULMOD 32 | | 0x0A -> EXP 33 | | 0x0B -> SIGNEXTEND 34 | | 0x10 -> LT 35 | | 0x11 -> GT 36 | | 0x12 -> SLT 37 | | 0x13 -> SGT 38 | | 0x14 -> EQ 39 | | 0x15 -> ISZERO 40 | | 0x16 -> AND 41 | | 0x17 -> OR 42 | | 0x18 -> XOR 43 | | 0x19 -> NOT 44 | | 0x1A -> BYTE 45 | | 0x1B -> SHL 46 | | 0x1C -> SHR 47 | | 0x1D -> SAR 48 | | 0x20 -> SHA3 49 | | 0x30 -> ADDRESS 50 | | 0x31 -> BALANCE 51 | | 0x32 -> ORIGIN 52 | | 0x33 -> CALLER 53 | | 0x34 -> CALLVALUE 54 | | 0x35 -> CALLDATALOAD 55 | | 0x36 -> CALLDATASIZE 56 | | 0x37 -> CALLDATACOPY 57 | | 0x38 -> CODESIZE 58 | | 0x39 -> CODECOPY 59 | | 0x3A -> GASPRICE 60 | | 0x3B -> EXTCODESIZE 61 | | 0x3C -> EXTCODECOPY 62 | | 0x3D -> RETURNDATASIZE 63 | | 0x3E -> RETURNDATACOPY 64 | | 0x3F -> EXTCODEHASH 65 | | 0x40 -> BLOCKHASH 66 | | 0x41 -> COINBASE 67 | | 0x42 -> TIMESTAMP 68 | | 0x43 -> NUMBER 69 | | 0x44 -> DIFFICULTY 70 | | 0x45 -> GASLIMIT 71 | | 0x50 -> POP 72 | | 0x51 -> MLOAD 73 | | 0x52 -> MSTORE 74 | | 0x53 -> MSTORE8 75 | | 0x54 -> SLOAD 76 | | 0x55 -> SSTORE 77 | | 0x56 -> JUMP 78 | | 0x57 -> JUMPI 79 | | 0x58 -> PC 80 | | 0x59 -> MSIZE 81 | | 0x5A -> GAS 82 | | 0x5B -> JUMPDEST 83 | | 0x60 -> PUSH (1, "") 84 | | 0x61 -> PUSH (2, "") 85 | | 0x62 -> PUSH (3, "") 86 | | 0x63 -> PUSH (4, "") 87 | | 0x64 -> PUSH (5, "") 88 | | 0x65 -> PUSH (6, "") 89 | | 0x66 -> PUSH (7, "") 90 | | 0x67 -> PUSH (8, "") 91 | | 0x68 -> PUSH (9, "") 92 | | 0x69 -> PUSH (10, "") 93 | | 0x6A -> PUSH (11, "") 94 | | 0x6B -> PUSH (12, "") 95 | | 0x6C -> PUSH (13, "") 96 | | 0x6D -> PUSH (14, "") 97 | | 0x6E -> PUSH (15, "") 98 | | 0x6F -> PUSH (16, "") 99 | | 0x70 -> PUSH (17, "") 100 | | 0x71 -> PUSH (18, "") 101 | | 0x72 -> PUSH (19, "") 102 | | 0x73 -> PUSH (20, "") 103 | | 0x74 -> PUSH (21, "") 104 | | 0x75 -> PUSH (22, "") 105 | | 0x76 -> PUSH (23, "") 106 | | 0x77 -> PUSH (24, "") 107 | | 0x78 -> PUSH (25, "") 108 | | 0x79 -> PUSH (26, "") 109 | | 0x7A -> PUSH (27, "") 110 | | 0x7B -> PUSH (28, "") 111 | | 0x7C -> PUSH (29, "") 112 | | 0x7D -> PUSH (30, "") 113 | | 0x7E -> PUSH (31, "") 114 | | 0x7F -> PUSH (32, "") 115 | | 0x80 -> DUP 1 116 | | 0x81 -> DUP 2 117 | | 0x82 -> DUP 3 118 | | 0x83 -> DUP 4 119 | | 0x84 -> DUP 5 120 | | 0x85 -> DUP 6 121 | | 0x86 -> DUP 7 122 | | 0x87 -> DUP 8 123 | | 0x88 -> DUP 9 124 | | 0x89 -> DUP 10 125 | | 0x8A -> DUP 11 126 | | 0x8B -> DUP 12 127 | | 0x8C -> DUP 13 128 | | 0x8D -> DUP 14 129 | | 0x8E -> DUP 15 130 | | 0x8F -> DUP 16 131 | | 0x90 -> SWAP 1 132 | | 0x91 -> SWAP 2 133 | | 0x92 -> SWAP 3 134 | | 0x93 -> SWAP 4 135 | | 0x94 -> SWAP 5 136 | | 0x95 -> SWAP 6 137 | | 0x96 -> SWAP 7 138 | | 0x97 -> SWAP 8 139 | | 0x98 -> SWAP 9 140 | | 0x99 -> SWAP 10 141 | | 0x9A -> SWAP 11 142 | | 0x9B -> SWAP 12 143 | | 0x9C -> SWAP 13 144 | | 0x9D -> SWAP 14 145 | | 0x9E -> SWAP 15 146 | | 0x9F -> SWAP 16 147 | | 0xA0 -> LOG0 148 | | 0xA1 -> LOG1 149 | | 0xA2 -> LOG2 150 | | 0xA3 -> LOG3 151 | | 0xA4 -> LOG4 152 | | 0xF0 -> CREATE 153 | | 0xF1 -> CALL 154 | | 0xF2 -> CALLCODE 155 | | 0xF3 -> RETURN 156 | | 0xF4 -> DELEGATECALL 157 | | 0xF5 -> CREATE2 158 | | 0xFA -> STATICCALL 159 | | 0xFD -> REVERT 160 | | 0xFE -> INVALID 161 | | 0xFF -> SELFDESTRUCT 162 | | x -> failwith (Printf.sprintf "invalid opcode: 0x%x" x) 163 | -------------------------------------------------------------------------------- /lib/EVM/decode.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val decode : string -> program 4 | 5 | val decode_opcodes : string -> opcode list 6 | 7 | val decode_opcode : int -> opcode 8 | -------------------------------------------------------------------------------- /lib/EVM/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name EVM) 3 | (modules EVM) 4 | (wrapped false) 5 | (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 6 | (preprocessor_deps 7 | abi.ml 8 | abi.mli 9 | construct.ml 10 | construct.mli 11 | debug.ml 12 | debug.mli 13 | decode.ml 14 | decode.mli 15 | encode.ml 16 | encode.mli 17 | metrics.ml 18 | metrics.mli 19 | opcodes.ml 20 | print.ml 21 | print.mli 22 | utility.ml 23 | utility.mli) 24 | (libraries cryptokit num)) 25 | -------------------------------------------------------------------------------- /lib/EVM/encode.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let rec encode_program program = 4 | let buffer = Buffer.create (program_size program) in 5 | encode_program_into_buffer buffer program; 6 | Buffer.contents buffer 7 | 8 | and encode_program_into_buffer buffer program = 9 | List.iter (encode_block_into_buffer buffer) program 10 | 11 | and encode_block block = 12 | let buffer = Buffer.create (block_size block) in 13 | encode_block_into_buffer buffer block; 14 | Buffer.contents buffer 15 | 16 | and encode_block_into_buffer buffer (_, block_body) = 17 | encode_opcodes_into_buffer buffer block_body 18 | 19 | and encode_operands = function 20 | | PUSH (_, s) -> s 21 | | _ -> "" 22 | 23 | and encode_opcodes ops = 24 | let buffer = Buffer.create (List.length ops) in (* TODO *) 25 | encode_opcodes_into_buffer buffer ops; 26 | Buffer.contents buffer 27 | 28 | and encode_opcodes_into_buffer buffer ops = 29 | let rec encode_loop = function 30 | | [] -> () 31 | | op :: ops -> begin 32 | let opcode = encode_opcode op |> Char.chr in 33 | let operands = encode_operands op in 34 | Buffer.add_char buffer opcode; 35 | Buffer.add_string buffer operands; 36 | encode_loop ops 37 | end 38 | in 39 | encode_loop ops 40 | 41 | and encode_opcode = function 42 | | STOP -> 0x00 43 | | ADD -> 0x01 44 | | MUL -> 0x02 45 | | SUB -> 0x03 46 | | DIV -> 0x04 47 | | SDIV -> 0x05 48 | | MOD -> 0x06 49 | | SMOD -> 0x07 50 | | ADDMOD -> 0x08 51 | | MULMOD -> 0x09 52 | | EXP -> 0x0A 53 | | SIGNEXTEND -> 0x0B 54 | | LT -> 0x10 55 | | GT -> 0x11 56 | | SLT -> 0x12 57 | | SGT -> 0x13 58 | | EQ -> 0x14 59 | | ISZERO -> 0x15 60 | | AND -> 0x16 61 | | OR -> 0x17 62 | | XOR -> 0x18 63 | | NOT -> 0x19 64 | | BYTE -> 0x1A 65 | | SHL -> 0x1B 66 | | SHR -> 0x1C 67 | | SAR -> 0x1D 68 | | SHA3 -> 0x20 69 | | ADDRESS -> 0x30 70 | | BALANCE -> 0x31 71 | | ORIGIN -> 0x32 72 | | CALLER -> 0x33 73 | | CALLVALUE -> 0x34 74 | | CALLDATALOAD -> 0x35 75 | | CALLDATASIZE -> 0x36 76 | | CALLDATACOPY -> 0x37 77 | | CODESIZE -> 0x38 78 | | CODECOPY -> 0x39 79 | | GASPRICE -> 0x3A 80 | | EXTCODESIZE -> 0x3B 81 | | EXTCODECOPY -> 0x3C 82 | | RETURNDATASIZE -> 0x3D 83 | | RETURNDATACOPY -> 0x3E 84 | | EXTCODEHASH -> 0x3F 85 | | BLOCKHASH -> 0x40 86 | | COINBASE -> 0x41 87 | | TIMESTAMP -> 0x42 88 | | NUMBER -> 0x43 89 | | DIFFICULTY -> 0x44 90 | | GASLIMIT -> 0x45 91 | | POP -> 0x50 92 | | MLOAD -> 0x51 93 | | MSTORE -> 0x52 94 | | MSTORE8 -> 0x53 95 | | SLOAD -> 0x54 96 | | SSTORE -> 0x55 97 | | JUMP -> 0x56 98 | | JUMPI -> 0x57 99 | | PC -> 0x58 100 | | MSIZE -> 0x59 101 | | GAS -> 0x5A 102 | | JUMPDEST -> 0x5B 103 | | PUSH (0, _) -> unreachable () 104 | | PUSH (n, _) -> 0x60 + n - 1 105 | | DUP n -> 0x80 + n - 1 106 | | SWAP n -> 0x90 + n - 1 107 | | LOG0 -> 0xA0 108 | | LOG1 -> 0xA1 109 | | LOG2 -> 0xA2 110 | | LOG3 -> 0xA3 111 | | LOG4 -> 0xA4 112 | | CREATE -> 0xF0 113 | | CALL -> 0xF1 114 | | CALLCODE -> 0xF2 115 | | RETURN -> 0xF3 116 | | DELEGATECALL -> 0xF4 117 | | CREATE2 -> 0xF5 118 | | STATICCALL -> 0xFA 119 | | REVERT -> 0xFD 120 | | INVALID -> 0xFE 121 | | SELFDESTRUCT -> 0xFF 122 | -------------------------------------------------------------------------------- /lib/EVM/encode.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val encode_program : program -> string 4 | 5 | val encode_program_into_buffer : Buffer.t -> program -> unit 6 | 7 | val encode_block : block -> string 8 | 9 | val encode_block_into_buffer : Buffer.t -> block -> unit 10 | 11 | val encode_opcodes : opcode list -> string 12 | 13 | val encode_opcodes_into_buffer : Buffer.t -> opcode list -> unit 14 | 15 | val encode_opcode : opcode -> int 16 | -------------------------------------------------------------------------------- /lib/EVM/metrics.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let rec program_size program = 4 | List.fold_left (fun sum block -> sum + block_size block) 0 program 5 | 6 | and block_size (_, block) = opcodes_size block 7 | 8 | and opcodes_size opcodes = 9 | List.fold_left (fun sum op -> sum + opcode_size op) 0 opcodes 10 | 11 | and opcode_size = function 12 | | PUSH (n, _) -> 1 + n 13 | | _ -> 1 14 | -------------------------------------------------------------------------------- /lib/EVM/metrics.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val program_size : program -> int 4 | 5 | val block_size : block -> int 6 | 7 | val opcodes_size : opcode list -> int 8 | 9 | val opcode_size : opcode -> int 10 | -------------------------------------------------------------------------------- /lib/EVM/opcodes.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | type contract = program * program 4 | 5 | and program = block list 6 | 7 | and block = int * opcode list 8 | 9 | and opcode = 10 | (* 0x00s: Stop & Arithmetic Operations *) 11 | | STOP 12 | | ADD 13 | | MUL 14 | | SUB 15 | | DIV 16 | | SDIV 17 | | MOD 18 | | SMOD 19 | | ADDMOD 20 | | MULMOD 21 | | EXP 22 | | SIGNEXTEND 23 | 24 | (* 0x10s: Comparison & Bitwise Logic Operations *) 25 | | LT 26 | | GT 27 | | SLT 28 | | SGT 29 | | EQ 30 | | ISZERO 31 | | AND 32 | | OR 33 | | XOR 34 | | NOT 35 | | BYTE 36 | | SHL (* EIP-145 *) 37 | | SHR (* EIP-145 *) 38 | | SAR (* EIP-145 *) 39 | 40 | (* 0x20s: SHA3 *) 41 | | SHA3 42 | 43 | (* 0x30s: Environmental Information *) 44 | | ADDRESS 45 | | BALANCE 46 | | ORIGIN 47 | | CALLER 48 | | CALLVALUE 49 | | CALLDATALOAD 50 | | CALLDATASIZE 51 | | CALLDATACOPY 52 | | CODESIZE 53 | | CODECOPY 54 | | GASPRICE 55 | | EXTCODESIZE 56 | | EXTCODECOPY 57 | | RETURNDATASIZE (* EIP-211 *) 58 | | RETURNDATACOPY (* EIP-211 *) 59 | | EXTCODEHASH (* EIP-1052 *) 60 | 61 | (* 0x40s: Block Information *) 62 | | BLOCKHASH 63 | | COINBASE 64 | | TIMESTAMP 65 | | NUMBER 66 | | DIFFICULTY 67 | | GASLIMIT 68 | 69 | (* 0x50s: Stack, Memory, Storage, and Flow Operations *) 70 | | POP 71 | | MLOAD 72 | | MSTORE 73 | | MSTORE8 74 | | SLOAD 75 | | SSTORE 76 | | JUMP 77 | | JUMPI 78 | | PC 79 | | MSIZE 80 | | GAS 81 | | JUMPDEST 82 | 83 | (* 0x60-70s: Push Operations *) 84 | | PUSH of int * string 85 | 86 | (* 0x80s: Duplication Operations *) 87 | | DUP of int 88 | 89 | (* 0x90s: Exchange Operations *) 90 | | SWAP of int 91 | 92 | (* 0xA0s: Logging Operations *) 93 | | LOG0 94 | | LOG1 95 | | LOG2 96 | | LOG3 97 | | LOG4 98 | 99 | (* 0xF0s: System Operations *) 100 | | CREATE 101 | | CALL 102 | | CALLCODE 103 | | RETURN 104 | | DELEGATECALL 105 | | CREATE2 (* EIP-1014 *) 106 | | STATICCALL (* EIP-214 *) 107 | | REVERT (* EIP-140 *) 108 | | INVALID (* EIP-141 *) 109 | | SELFDESTRUCT 110 | -------------------------------------------------------------------------------- /lib/EVM/print.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let rec print_program_as_bytecode ppf program = 4 | List.iter (print_block_as_bytecode ppf) program 5 | 6 | and print_program_as_opcode ppf program = 7 | List.iteri (print_block_as_opcode ppf) program 8 | 9 | and print_block_as_bytecode ppf block = 10 | let bytecode = encode_block block in 11 | let print_byte b = Format.fprintf ppf "%02x@," @@ Char.code b in 12 | String.iter print_byte bytecode 13 | 14 | and print_block_as_opcode ppf index = function 15 | | (_, []) -> () 16 | | (_, block_body) -> 17 | if index > 0 then Format.pp_print_space ppf (); 18 | print_opcodes ppf block_body 19 | 20 | and print_opcodes ppf ops = 21 | let open Format in 22 | pp_print_list ~pp_sep:pp_print_space print_opcode ppf ops 23 | 24 | and print_opcode ppf op = 25 | Format.fprintf ppf "%s" @@ to_string op 26 | 27 | and print_operand ppf s = 28 | Format.pp_print_string ppf "0x"; 29 | String.iter (fun b -> Format.fprintf ppf "%02x" (Char.code b)) s 30 | 31 | and to_string = function 32 | | STOP -> "STOP" 33 | | ADD -> "ADD" 34 | | MUL -> "MUL" 35 | | SUB -> "SUB" 36 | | DIV -> "DIV" 37 | | SDIV -> "SDIV" 38 | | MOD -> "MOD" 39 | | SMOD -> "SMOD" 40 | | ADDMOD -> "ADDMOD" 41 | | MULMOD -> "MULMOD" 42 | | EXP -> "EXP" 43 | | SIGNEXTEND -> "SIGNEXTEND" 44 | | LT -> "LT" 45 | | GT -> "GT" 46 | | SLT -> "SLT" 47 | | SGT -> "SGT" 48 | | EQ -> "EQ" 49 | | ISZERO -> "ISZERO" 50 | | AND -> "AND" 51 | | OR -> "OR" 52 | | XOR -> "XOR" 53 | | NOT -> "NOT" 54 | | BYTE -> "BYTE" 55 | | SHL -> "SHL" 56 | | SHR -> "SHR" 57 | | SAR -> "SAR" 58 | | SHA3 -> "SHA3" 59 | | ADDRESS -> "ADDRESS" 60 | | BALANCE -> "BALANCE" 61 | | ORIGIN -> "ORIGIN" 62 | | CALLER -> "CALLER" 63 | | CALLVALUE -> "CALLVALUE" 64 | | CALLDATALOAD -> "CALLDATALOAD" 65 | | CALLDATASIZE -> "CALLDATASIZE" 66 | | CALLDATACOPY -> "CALLDATACOPY" 67 | | CODESIZE -> "CODESIZE" 68 | | CODECOPY -> "CODECOPY" 69 | | GASPRICE -> "GASPRICE" 70 | | EXTCODESIZE -> "EXTCODESIZE" 71 | | EXTCODECOPY -> "EXTCODECOPY" 72 | | RETURNDATASIZE -> "RETURNDATASIZE" 73 | | RETURNDATACOPY -> "RETURNDATACOPY" 74 | | EXTCODEHASH -> "EXTCODEHASH" 75 | | BLOCKHASH -> "BLOCKHASH" 76 | | COINBASE -> "COINBASE" 77 | | TIMESTAMP -> "TIMESTAMP" 78 | | NUMBER -> "NUMBER" 79 | | DIFFICULTY -> "DIFFICULTY" 80 | | GASLIMIT -> "GASLIMIT" 81 | | POP -> "POP" 82 | | MLOAD -> "MLOAD" 83 | | MSTORE -> "MSTORE" 84 | | MSTORE8 -> "MSTORE8" 85 | | SLOAD -> "SLOAD" 86 | | SSTORE -> "SSTORE" 87 | | JUMP -> "JUMP" 88 | | JUMPI -> "JUMPI" 89 | | PC -> "PC" 90 | | MSIZE -> "MSIZE" 91 | | GAS -> "GAS" 92 | | JUMPDEST -> "JUMPDEST" 93 | | PUSH (n, s) -> begin 94 | let buffer = Buffer.create (2 * (String.length s)) in 95 | let ppf = Format.formatter_of_buffer buffer in 96 | print_operand ppf s; 97 | Format.pp_print_flush ppf (); 98 | Format.sprintf "PUSH%d %s" n (Buffer.contents buffer) 99 | end 100 | | DUP n -> Format.sprintf "DUP%d" n 101 | | SWAP n -> Format.sprintf "SWAP%d" n 102 | | LOG0 -> "LOG0" 103 | | LOG1 -> "LOG1" 104 | | LOG2 -> "LOG2" 105 | | LOG3 -> "LOG3" 106 | | LOG4 -> "LOG4" 107 | | CREATE -> "CREATE" 108 | | CALL -> "CALL" 109 | | CALLCODE -> "CALLCODE" 110 | | RETURN -> "RETURN" 111 | | DELEGATECALL -> "DELEGATECALL" 112 | | CREATE2 -> "CREATE2" 113 | | STATICCALL -> "STATICCALL" 114 | | REVERT -> "REVERT" 115 | | INVALID -> "INVALID" 116 | | SELFDESTRUCT -> "SELFDESTRUCT" 117 | -------------------------------------------------------------------------------- /lib/EVM/print.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val print_program_as_bytecode : Format.formatter -> program -> unit 4 | 5 | val print_program_as_opcode : Format.formatter -> program -> unit 6 | 7 | val print_opcodes : Format.formatter -> opcode list -> unit 8 | 9 | val print_opcode : Format.formatter -> opcode -> unit 10 | 11 | val to_string : opcode -> string 12 | -------------------------------------------------------------------------------- /lib/EVM/utility.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let unreachable () = failwith "unreachable" 4 | 5 | let unimplemented what = 6 | let message = 7 | if what = "" then "not implemented yet" 8 | else Printf.sprintf "%s not implemented yet" what 9 | in 10 | failwith message 11 | 12 | let unsupported what = 13 | let message = 14 | if what = "" then "not supported" 15 | else Printf.sprintf "%s not supported" what 16 | in 17 | failwith message 18 | -------------------------------------------------------------------------------- /lib/EVM/utility.mli: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | val unreachable : unit -> unit 4 | 5 | val unimplemented : string -> unit 6 | 7 | val unsupported : string -> unit 8 | -------------------------------------------------------------------------------- /test/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/weavery/clarc/1fb1c43210f52b4022e7f0ae30b7c7d4a9e7ca01/test/.gitkeep -------------------------------------------------------------------------------- /test/contracts.t: -------------------------------------------------------------------------------- 1 | counter.clar: 2 | 3 | $ clarc -t opcode ../../../../../etc/examples/counter.clar 4 | PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x66 DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY 5 | PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1 6 | PUSH4 0x8ada066e EQ PUSH1 0x28 JUMPI DUP1 PUSH4 0xd09de08a EQ PUSH1 0x38 7 | JUMPI DUP1 PUSH4 0x2baeceb7 EQ PUSH1 0x4f JUMPI STOP JUMPDEST POP PUSH1 0x00 8 | SLOAD PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP JUMPDEST 9 | POP PUSH1 0x01 PUSH1 0x00 SLOAD ADD PUSH1 0x00 SSTORE PUSH1 0x00 SLOAD 10 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP JUMPDEST POP PUSH1 0x01 11 | PUSH1 0x00 SLOAD SUB PUSH1 0x00 SSTORE PUSH1 0x00 SLOAD PUSH1 0x00 MSTORE 12 | PUSH1 0x20 PUSH1 0x00 RETURN STOP 13 | 14 | kv-store.clar: 15 | 16 | $ clarc -t opcode ../../../../../etc/examples/kv-store.clar 17 | PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x6a DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY 18 | PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1 19 | PUSH4 0x3ccc0522 EQ PUSH1 0x1e JUMPI DUP1 PUSH4 0x6435c3e7 EQ PUSH1 0x50 20 | JUMPI STOP JUMPDEST POP CALLER SLOAD DUP1 ISZERO NOT ISZERO ISZERO PC 21 | PUSH1 0x0f ADD JUMPI POP PUSH1 0x00 PUSH1 0x00 PC PUSH1 0x15 ADD JUMP 22 | JUMPDEST PUSH1 0x80 PUSH1 0x02 EXP MUL PUSH1 0x80 PUSH1 0x02 EXP SWAP1 DIV 23 | PUSH1 0x01 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 24 | JUMPDEST POP PUSH1 0x64 PUSH1 0x80 PUSH1 0x02 EXP MUL PUSH1 0x07 OR ORIGIN 25 | SSTORE PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 26 | 27 | panic.clar: 28 | 29 | $ clarc -t opcode ../../../../../etc/examples/panic.clar 30 | PUSH1 0x00 PUSH1 0x00 SSTORE PUSH1 0x62 DUP1 PUSH1 0x10 PUSH1 0x00 CODECOPY 31 | PUSH1 0x00 RETURN PUSH1 0xe0 PUSH1 0x02 EXP PUSH1 0x00 CALLDATALOAD DIV DUP1 32 | PUSH4 0xc2187034 EQ PUSH1 0x3a JUMPI DUP1 PUSH4 0x4700d305 EQ PUSH1 0x4f 33 | JUMPI STOP JUMPDEST PUSH1 0x00 SLOAD DUP1 ISZERO ISZERO PC PUSH1 0x0f ADD 34 | JUMPI POP PUSH1 0x00 DUP1 REVERT PC PUSH1 0x07 ADD JUMP JUMPDEST SLOAD 35 | JUMPDEST SWAP1 JUMP STOP JUMPDEST POP PC PUSH1 0x07 ADD PUSH1 0x1e JUMP 36 | JUMPDEST PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 37 | JUMPDEST POP PC PUSH1 0x07 ADD PUSH1 0x1e JUMP JUMPDEST PUSH1 0x00 MSTORE 38 | PUSH1 0x20 PUSH1 0x00 RETURN STOP 39 | -------------------------------------------------------------------------------- /test/definitions.t: -------------------------------------------------------------------------------- 1 | define-constant: 2 | 3 | define-data-var: 4 | 5 | define-fungible-token: 6 | 7 | define-map: 8 | 9 | define-non-fungible-token: 10 | 11 | define-private: 12 | 13 | define-public: 14 | 15 | define-read-only: 16 | 17 | define-trait: Not implemented yet. 18 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_hash) 3 | (modules test_hash) 4 | (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 5 | (libraries Clar2EVM alcotest)) 6 | -------------------------------------------------------------------------------- /test/functions.t: -------------------------------------------------------------------------------- 1 | https://docs.blockstack.org/references/language-functions 2 | 3 | +: For two parameters. Without overflow checking. 4 | 5 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (+ 6 7)) 7 | > EOF 8 | PUSH1 0x07 PUSH1 0x06 ADD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 9 | 10 | -: For two parameters. Without underflow checking. 11 | 12 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (- 6 7)) 14 | > EOF 15 | PUSH1 0x07 PUSH1 0x06 SUB PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 16 | 17 | *: For two parameters. Without overflow checking. 18 | 19 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (* 6 7)) 21 | > EOF 22 | PUSH1 0x07 PUSH1 0x06 MUL PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 23 | 24 | /: For two parameters. Without division-by-zero checking. 25 | 26 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (/ 6 3)) 28 | > EOF 29 | PUSH1 0x03 PUSH1 0x06 DIV PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 30 | 31 | <: 32 | 33 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (< 1 2)) 35 | > EOF 36 | PUSH1 0x02 PUSH1 0x01 LT PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 37 | 38 | <=: 39 | 40 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (<= 1 2)) 42 | > EOF 43 | PUSH1 0x02 PUSH1 0x01 DUP2 DUP2 LT SWAP2 SWAP1 EQ OR PUSH1 0x00 MSTORE 44 | PUSH1 0x20 PUSH1 0x00 RETURN STOP 45 | 46 | >: 47 | 48 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (> 1 2)) 50 | > EOF 51 | PUSH1 0x02 PUSH1 0x01 GT PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 52 | 53 | >=: 54 | 55 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (>= 1 2)) 57 | > EOF 58 | PUSH1 0x02 PUSH1 0x01 DUP2 DUP2 GT SWAP2 SWAP1 EQ OR PUSH1 0x00 MSTORE 59 | PUSH1 0x20 PUSH1 0x00 RETURN STOP 60 | 61 | append: 62 | 63 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (append (list 5 6 7) 8)) 65 | > EOF 66 | PUSH1 0x05 PUSH1 0x06 PUSH1 0x07 PUSH1 0x03 POP PUSH1 0x08 PUSH1 0x04 67 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 68 | 69 | asserts!: 70 | 71 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (asserts! false (err 7))) 73 | > EOF 74 | PUSH1 0x00 ISZERO PC PUSH1 0x0c ADD JUMPI PUSH1 0x01 PC PUSH1 0x0a ADD JUMP 75 | JUMPDEST PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 76 | PUSH1 0x00 RETURN STOP 77 | 78 | concat: Only for lists. 79 | 80 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (concat (list 5 6) (list 7 8))) 82 | > EOF 83 | PUSH1 0x05 PUSH1 0x06 PUSH1 0x02 POP PUSH1 0x07 PUSH1 0x08 PUSH1 0x02 POP 84 | PUSH1 0x04 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 85 | 86 | default-to: 87 | 88 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (default-to 7 none)) 90 | > EOF 91 | PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x08 ADD JUMP JUMPDEST 92 | PUSH1 0x07 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 93 | 94 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (default-to 7 (some 9))) 96 | > EOF 97 | PUSH1 0x09 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x08 ADD JUMP 98 | JUMPDEST PUSH1 0x07 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 99 | STOP 100 | 101 | err: 102 | 103 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (err 5)) 105 | > EOF 106 | PUSH1 0x05 PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 107 | 108 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (err u5)) 110 | > EOF 111 | PUSH1 0x05 PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 112 | 113 | filter: 114 | 115 | fold: 116 | 117 | ft-get-balance: 118 | 119 | ft-mint?: 120 | 121 | ft-transfer?: 122 | 123 | hash160: 124 | 125 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (hash160 0)) 127 | > EOF 128 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 PUSH1 0x10 PUSH1 0x00 129 | PUSH1 0x03 GAS STATICCALL POP PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 130 | STOP 131 | 132 | is-eq: For two parameters. 133 | 134 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq true false)) 136 | > EOF 137 | PUSH1 0x00 PUSH1 0x01 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 138 | 139 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq true true)) 141 | > EOF 142 | PUSH1 0x01 PUSH1 0x01 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 143 | 144 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq 7 9)) 146 | > EOF 147 | PUSH1 0x09 PUSH1 0x07 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 148 | 149 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq 9 9)) 151 | > EOF 152 | PUSH1 0x09 PUSH1 0x09 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 153 | 154 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq u9 u9)) 156 | > EOF 157 | PUSH1 0x09 PUSH1 0x09 EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 158 | 159 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq 0xAB 0xAB)) 161 | > EOF 162 | PUSH1 0xab PUSH1 0xab EQ PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 163 | 164 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-eq true 42)) 166 | > EOF 167 | clarc: internal error, uncaught exception: 168 | Failure("(is-eq bool int) not supported") 169 | 170 | [125] 171 | 172 | is-err: 173 | 174 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-err (err u5))) 176 | > EOF 177 | PUSH1 0x05 PUSH1 0x00 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 178 | STOP 179 | 180 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-err (ok true))) 182 | > EOF 183 | PUSH1 0x01 PUSH1 0x01 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 184 | STOP 185 | 186 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-err 42)) 188 | > EOF 189 | clarc: internal error, uncaught exception: 190 | Failure("(is-err int) not supported") 191 | 192 | [125] 193 | 194 | is-none: 195 | 196 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-none none)) 198 | > EOF 199 | PUSH1 0x00 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 200 | 201 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-none (some 5))) 203 | > EOF 204 | PUSH1 0x05 PUSH1 0x01 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 205 | STOP 206 | 207 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-none 42)) 209 | > EOF 210 | clarc: internal error, uncaught exception: 211 | Failure("(is-none int) not supported") 212 | 213 | [125] 214 | 215 | is-ok: 216 | 217 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-ok (err u5))) 219 | > EOF 220 | PUSH1 0x05 PUSH1 0x00 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 221 | RETURN STOP 222 | 223 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-ok (ok true))) 225 | > EOF 226 | PUSH1 0x01 PUSH1 0x01 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 227 | RETURN STOP 228 | 229 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-ok 42)) 231 | > EOF 232 | clarc: internal error, uncaught exception: 233 | Failure("(is-ok int) not supported") 234 | 235 | [125] 236 | 237 | is-some: 238 | 239 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-some none)) 241 | > EOF 242 | PUSH1 0x00 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 243 | 244 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-some (some 5))) 246 | > EOF 247 | PUSH1 0x05 PUSH1 0x01 ISZERO ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 248 | RETURN STOP 249 | 250 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (is-some 42)) 252 | > EOF 253 | clarc: internal error, uncaught exception: 254 | Failure("(is-some int) not supported") 255 | 256 | [125] 257 | 258 | keccak256: 259 | 260 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (keccak256 0x01020304)) 262 | > EOF 263 | PUSH4 0x01020304 PUSH1 0x00 MSTORE PUSH1 0x04 PUSH1 0x00 SHA3 PUSH1 0x00 264 | MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 265 | 266 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (keccak256 0)) 268 | > EOF 269 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x10 PUSH1 0x00 SHA3 PUSH1 0x00 MSTORE 270 | PUSH1 0x20 PUSH1 0x00 RETURN STOP 271 | 272 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (keccak256 (+ 1 2))) 274 | > EOF 275 | PUSH1 0x02 PUSH1 0x01 ADD PUSH1 0x00 MSTORE PUSH1 0x10 PUSH1 0x00 SHA3 276 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 277 | 278 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (keccak256 true)) 280 | > EOF 281 | clarc: internal error, uncaught exception: 282 | Failure("(keccak256 bool) not supported") 283 | 284 | [125] 285 | 286 | len: Only for literals. 287 | 288 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (len "")) 290 | > EOF 291 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 292 | 293 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (len "Hello, world!")) 295 | > EOF 296 | PUSH1 0x0d PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 297 | 298 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (len 0xDEADBEEF)) 300 | > EOF 301 | PUSH1 0x04 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 302 | 303 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (len (list))) 305 | > EOF 306 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 307 | 308 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (len (list 1 2 3))) 310 | > EOF 311 | PUSH1 0x03 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 312 | 313 | list: 314 | 315 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (list)) 317 | > EOF 318 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 319 | 320 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (list 7)) 322 | > EOF 323 | PUSH1 0x07 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 324 | 325 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (list 1 2 3)) 327 | > EOF 328 | PUSH1 0x01 PUSH1 0x02 PUSH1 0x03 PUSH1 0x03 PUSH1 0x00 MSTORE PUSH1 0x20 329 | PUSH1 0x00 RETURN STOP 330 | 331 | map: 332 | 333 | map-delete: 334 | 335 | map-get?: 336 | 337 | $ clarc -t opcode -f only-function=test < (define-map store ((key principal)) ((val int))) 339 | > (define-read-only (test) 340 | > (map-get? store {key: tx-sender})) 341 | > EOF 342 | CALLER SLOAD DUP1 ISZERO NOT PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 343 | STOP 344 | 345 | map-insert: 346 | 347 | map-set: 348 | 349 | mod: Without division-by-zero checking. 350 | 351 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (mod 5 2)) 353 | > EOF 354 | PUSH1 0x02 PUSH1 0x05 MOD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 355 | 356 | nft-get-owner?: 357 | 358 | nft-mint?: 359 | 360 | nft-transfer?: 361 | 362 | not: 363 | 364 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (not false)) 366 | > EOF 367 | PUSH1 0x00 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 368 | 369 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (not true)) 371 | > EOF 372 | PUSH1 0x01 ISZERO PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 373 | 374 | ok: 375 | 376 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (ok true)) 378 | > EOF 379 | PUSH1 0x01 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 380 | 381 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (ok 5)) 383 | > EOF 384 | PUSH1 0x05 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 385 | 386 | pow: Without overflow checking. 387 | 388 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (pow 2 3)) 390 | > EOF 391 | PUSH1 0x03 PUSH1 0x02 EXP PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 392 | 393 | principal-of?: 394 | 395 | print: Only for literals. Without a meaningful return value. 396 | 397 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (print 123)) 399 | > EOF 400 | PUSH1 0x00 401 | PUSH32 0x4e0c1d1d00000000000000000000000000000000000000000000000000000000 402 | PUSH1 0x00 MSTORE 403 | PUSH32 0x0000007b00000000000000000000000000000000000000000000000000000000 404 | PUSH1 0x01 MSTORE PUSH1 0x00 PUSH1 0x00 PUSH1 0x24 PUSH1 0x00 405 | PUSH20 0x000000000000000000636f6e736f6c652e6c6f67 GAS STATICCALL POP 406 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 407 | 408 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (print "Hello, world!")) 410 | > EOF 411 | PUSH1 0x00 412 | PUSH32 0x41304fac00000000000000000000000000000000000000000000000000000000 413 | PUSH1 0x00 MSTORE 414 | PUSH32 0x0000000d48656c6c6f2c20776f726c6421000000000000000000000000000000 415 | PUSH1 0x01 MSTORE 416 | PUSH32 0x0000000000000000000000000000000000000000000000000000000000000000 417 | PUSH1 0x02 MSTORE PUSH1 0x00 PUSH1 0x00 PUSH1 0x44 PUSH1 0x00 418 | PUSH20 0x000000000000000000636f6e736f6c652e6c6f67 GAS STATICCALL POP 419 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 420 | 421 | secp256k1-recover?: Not implemented yet. 422 | 423 | secp256k1-verify: Not implemented yet. 424 | 425 | sha256: 426 | 427 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (sha256 0)) 429 | > EOF 430 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 PUSH1 0x10 PUSH1 0x00 431 | PUSH1 0x02 GAS STATICCALL POP PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 432 | STOP 433 | 434 | sha512: Not implemented yet. 435 | 436 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (sha512 0)) 438 | > EOF 439 | clarc: internal error, uncaught exception: 440 | Failure("(sha512 int) not implemented yet") 441 | 442 | [125] 443 | 444 | sha512/256: Not implemented yet. 445 | 446 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (sha512/256 0)) 448 | > EOF 449 | clarc: internal error, uncaught exception: 450 | Failure("(sha512/256 int) not implemented yet") 451 | 452 | [125] 453 | 454 | some: 455 | 456 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (some 5)) 458 | > EOF 459 | PUSH1 0x05 PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 460 | 461 | sqrti: Not implemented yet. 462 | 463 | stx-burn?: Not supported. 464 | 465 | stx-get-balance: Not supported. 466 | 467 | stx-transfer?: Not supported. 468 | 469 | to-int: 470 | 471 | to-uint: 472 | 473 | try!: 474 | 475 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (try! none)) 477 | > EOF 478 | PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP JUMPDEST 479 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST PUSH1 0x00 480 | MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 481 | 482 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (try! (some 7))) 484 | > EOF 485 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP 486 | JUMPDEST PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST 487 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 488 | 489 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (try! (err 7))) 491 | > EOF 492 | PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x13 ADD JUMP 493 | JUMPDEST PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x01 MSTORE PUSH1 0x40 PUSH1 0x00 494 | RETURN JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 495 | 496 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (try! (ok 7))) 498 | > EOF 499 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x13 ADD JUMP 500 | JUMPDEST PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x01 MSTORE PUSH1 0x40 PUSH1 0x00 501 | RETURN JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 502 | 503 | unwrap-err!: 504 | 505 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-err! (err 7) 9)) 507 | > EOF 508 | PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x15 ADD JUMPI POP PUSH1 0x09 509 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN PC PUSH1 0x06 ADD JUMP 510 | JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 511 | 512 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-err! (ok 7) 9)) 514 | > EOF 515 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x15 ADD JUMPI POP PUSH1 0x09 516 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN PC PUSH1 0x06 ADD JUMP 517 | JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 518 | 519 | unwrap-err-panic: 520 | 521 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-err-panic (err 7))) 523 | > EOF 524 | PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0f ADD JUMPI POP PUSH1 0x00 DUP1 525 | REVERT PC PUSH1 0x06 ADD JUMP JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 526 | PUSH1 0x00 RETURN STOP 527 | 528 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-err-panic (ok 7))) 530 | > EOF 531 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0f ADD JUMPI POP PUSH1 0x00 DUP1 532 | REVERT PC PUSH1 0x06 ADD JUMP JUMPDEST JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 533 | PUSH1 0x00 RETURN STOP 534 | 535 | unwrap!: 536 | 537 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap! none 9)) 539 | > EOF 540 | PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP JUMPDEST 541 | PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST PUSH1 0x00 542 | MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 543 | 544 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap! (some 7) 9)) 546 | > EOF 547 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x10 ADD JUMP 548 | JUMPDEST PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN JUMPDEST 549 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 550 | 551 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap! (err 7) 9)) 553 | > EOF 554 | PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x11 ADD JUMP 555 | JUMPDEST POP PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 556 | JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 557 | 558 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap! (ok 7) 9)) 560 | > EOF 561 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x11 ADD JUMP 562 | JUMPDEST POP PUSH1 0x09 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 563 | JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 564 | 565 | unwrap-panic: 566 | 567 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-panic none)) 569 | > EOF 570 | PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0a ADD JUMP JUMPDEST 571 | PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 572 | RETURN STOP 573 | 574 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-panic (some 7))) 576 | > EOF 577 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0a ADD JUMP 578 | JUMPDEST PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 579 | PUSH1 0x00 RETURN STOP 580 | 581 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-panic (err 7))) 583 | > EOF 584 | PUSH1 0x07 PUSH1 0x00 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0b ADD JUMP 585 | JUMPDEST POP PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 586 | PUSH1 0x00 RETURN STOP 587 | 588 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (unwrap-panic (ok 7))) 590 | > EOF 591 | PUSH1 0x07 PUSH1 0x01 ISZERO PC PUSH1 0x0a ADD JUMPI PC PUSH1 0x0b ADD JUMP 592 | JUMPDEST POP PUSH1 0x00 DUP1 REVERT JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 593 | PUSH1 0x00 RETURN STOP 594 | 595 | xor: 596 | 597 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (xor 1 2)) 599 | > EOF 600 | PUSH1 0x02 PUSH1 0x01 XOR PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 601 | -------------------------------------------------------------------------------- /test/keywords.t: -------------------------------------------------------------------------------- 1 | https://docs.blockstack.org/references/language-keywords 2 | 3 | block-height: 4 | 5 | $ clarc -t opcode -f only-function=test < (define-read-only (test) block-height) 7 | > EOF 8 | NUMBER PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 9 | 10 | burn-block-height: 11 | 12 | $ clarc -t opcode -f only-function=test < (define-read-only (test) burn-block-height) 14 | > EOF 15 | NUMBER PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 16 | 17 | contract-caller: 18 | 19 | $ clarc -t opcode -f only-function=test < (define-read-only (test) contract-caller) 21 | > EOF 22 | CALLER PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 23 | 24 | is-in-regtest: 25 | 26 | $ clarc -t opcode -f only-function=test < (define-read-only (test) is-in-regtest) 28 | > EOF 29 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 30 | 31 | stx-liquid-supply: Not supported. 32 | 33 | $ clarc -t opcode -f only-function=test < (define-read-only (test) stx-liquid-supply) 35 | > EOF 36 | clarc: internal error, uncaught exception: 37 | Failure("stx-liquid-supply not supported") 38 | 39 | [125] 40 | 41 | tx-sender: 42 | 43 | $ clarc -t opcode -f only-function=test < (define-read-only (test) tx-sender) 45 | > EOF 46 | ORIGIN PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 47 | -------------------------------------------------------------------------------- /test/literals.t: -------------------------------------------------------------------------------- 1 | https://docs.blockstack.org/references/language-types 2 | 3 | none: 4 | 5 | $ clarc -t opcode -f only-function=test < (define-read-only (test) none) 7 | > EOF 8 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 9 | 10 | false: 11 | 12 | $ clarc -t opcode -f only-function=test < (define-read-only (test) false) 14 | > EOF 15 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 16 | 17 | true: 18 | 19 | $ clarc -t opcode -f only-function=test < (define-read-only (test) true) 21 | > EOF 22 | PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 23 | 24 | int: 25 | 26 | $ clarc -t opcode -f only-function=test < (define-read-only (test) 42) 28 | > EOF 29 | PUSH1 0x2a PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 30 | 31 | uint: 32 | 33 | $ clarc -t opcode -f only-function=test < (define-read-only (test) u42) 35 | > EOF 36 | PUSH1 0x2a PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 37 | 38 | principal: 39 | 40 | buff: 41 | 42 | $ clarc -t opcode -f only-function=test < (define-read-only (test) 0x00) 44 | > EOF 45 | PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 46 | 47 | $ clarc -t opcode -f only-function=test < (define-read-only (test) 0x0000000000000000000000000000000000000000000000000000000000000000) 49 | > EOF 50 | PUSH32 0x0000000000000000000000000000000000000000000000000000000000000000 51 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 52 | 53 | $ clarc -t opcode -f only-function=test < (define-read-only (test) 0x0102) 55 | > EOF 56 | PUSH2 0x0102 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 57 | 58 | $ clarc -t opcode -f only-function=test < (define-read-only (test) 0x0102030405060708091011121314151617181920212223242526272829303132) 60 | > EOF 61 | PUSH32 0x0102030405060708091011121314151617181920212223242526272829303132 62 | PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 63 | 64 | string: 65 | 66 | $ clarc -t opcode -f only-function=test < (define-read-only (test) "") 68 | > EOF 69 | PUSH1 0x00 PUSH1 0x00 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 70 | 71 | $ clarc -t opcode -f only-function=test < (define-read-only (test) "Hello, world!") 73 | > EOF 74 | PUSH13 0x48656c6c6f2c20776f726c6421 PUSH1 0x0d PUSH1 0x00 MSTORE PUSH1 0x20 75 | PUSH1 0x00 RETURN STOP 76 | 77 | list: 78 | 79 | tuple: 80 | -------------------------------------------------------------------------------- /test/operators.t: -------------------------------------------------------------------------------- 1 | https://docs.blockstack.org/references/language-functions 2 | 3 | and: For two parameters. 4 | 5 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (and true false)) 7 | > EOF 8 | PUSH1 0x00 PUSH1 0x01 AND PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 9 | 10 | as-contract: 11 | 12 | as-max-len?: 13 | 14 | at-block: Not implemented yet. 15 | 16 | begin: 17 | 18 | contract-call?: Not implemented yet. 19 | 20 | contract-of: Not implemented yet. 21 | 22 | get: 23 | 24 | get-block-info?: Not implemented yet. 25 | 26 | if: 27 | 28 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (if true 5 7)) 30 | > EOF 31 | PUSH1 0x01 ISZERO PC PUSH1 0x0c ADD JUMPI PUSH1 0x05 PC PUSH1 0x08 ADD JUMP 32 | JUMPDEST PUSH1 0x07 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 33 | STOP 34 | 35 | impl-trait: Not implemented yet. 36 | 37 | let: 38 | 39 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (let ((x 7)) x)) 41 | > EOF 42 | PUSH1 0x07 DUP1 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 43 | 44 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (let ((x 7) (y 9)) x)) 46 | > EOF 47 | PUSH1 0x07 PUSH1 0x09 DUP2 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 48 | STOP 49 | 50 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (let ((x 7) (y 9)) y)) 52 | > EOF 53 | PUSH1 0x07 PUSH1 0x09 DUP1 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 54 | STOP 55 | 56 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (let ((x 7)) (let ((x 9)) x))) 58 | > EOF 59 | PUSH1 0x07 PUSH1 0x09 DUP1 PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN 60 | STOP 61 | 62 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (let ((x 7)) y)) 64 | > EOF 65 | clarc: internal error, uncaught exception: 66 | Failure("unbound variable: y") 67 | 68 | [125] 69 | 70 | match: 71 | 72 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (match (some 3) x 5 7)) 74 | > EOF 75 | PUSH1 0x03 PUSH1 0x01 ISZERO ISZERO PC PUSH1 0x0d ADD JUMPI POP PUSH1 0x07 PC 76 | PUSH1 0x08 ADD JUMP JUMPDEST PUSH1 0x05 JUMPDEST PUSH1 0x00 MSTORE PUSH1 0x20 77 | PUSH1 0x00 RETURN STOP 78 | 79 | or: For two parameters. 80 | 81 | $ clarc -t opcode -f only-function=test < (define-read-only (test) (or true false)) 83 | > EOF 84 | PUSH1 0x00 PUSH1 0x01 OR PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 85 | 86 | tuple: 87 | 88 | use-trait: Not implemented yet. 89 | 90 | var-get: 91 | 92 | $ clarc -t opcode -f only-function=test < (define-data-var counter int 0) 94 | > (define-read-only (test) 95 | > (var-get counter)) 96 | > EOF 97 | PUSH1 0x00 SLOAD PUSH1 0x00 MSTORE PUSH1 0x20 PUSH1 0x00 RETURN STOP 98 | 99 | var-set: 100 | 101 | $ clarc -t opcode -f only-function=test < (define-data-var counter int 0) 103 | > (define-public (test) 104 | > (begin 105 | > (var-set counter 42) 106 | > (ok true))) 107 | > EOF 108 | PUSH1 0x2a PUSH1 0x00 SSTORE PUSH1 0x01 PUSH1 0x00 MSTORE PUSH1 0x20 109 | PUSH1 0x00 RETURN STOP 110 | -------------------------------------------------------------------------------- /test/test_hash.ml: -------------------------------------------------------------------------------- 1 | (* This is free and unencumbered software released into the public domain. *) 2 | 3 | let keccak256 input = 4 | let hash_function = Cryptokit.Hash.keccak 256 in 5 | let hash = Cryptokit.hash_string hash_function input in 6 | String.sub hash 0 4 7 | 8 | let keccak () = 9 | Alcotest.(check string) "" (keccak256 "abc") "\x4e\x03\x65\x7a"; 10 | Alcotest.(check string) "" (keccak256 "getCounter()") "\x8a\xda\x06\x6e"; 11 | Alcotest.(check string) "" (keccak256 "increment()") "\xd0\x9d\xe0\x8a"; 12 | Alcotest.(check string) "" (keccak256 "decrement()") "\x2b\xae\xce\xb7" 13 | 14 | let () = 15 | Alcotest.run "Clar2EVM" [ 16 | "function_hash", [ 17 | "keccak", `Quick, keccak; 18 | ]; 19 | ] 20 | --------------------------------------------------------------------------------