Compare commits

..

1 Commits

Author SHA1 Message Date
skkw
de20469609 Added subname TX 2019-08-30 14:13:08 +02:00
283 changed files with 11593 additions and 19592 deletions

37
.circleci/config.yml Normal file
View File

@ -0,0 +1,37 @@
version: 2.1
executors:
aebuilder:
docker:
- image: aeternity/builder
user: builder
working_directory: ~/aesophia
jobs:
build:
executor: aebuilder
steps:
- checkout
- restore_cache:
keys:
- dialyzer-cache-v2-{{ .Branch }}-{{ .Revision }}
- dialyzer-cache-v2-{{ .Branch }}-
- dialyzer-cache-v2-
- run:
name: Build
command: ./rebar3 compile
- run:
name: Static Analysis
command: ./rebar3 dialyzer
- run:
name: Eunit
command: ./rebar3 eunit
- run:
name: Common Tests
command: ./rebar3 ct
- save_cache:
key: dialyzer-cache-v2-{{ .Branch }}-{{ .Revision }}
paths:
- _build/default/rebar3_20.3.8_plt
- store_artifacts:
path: _build/test/logs

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.0 KiB

View File

@ -1,7 +0,0 @@
import glob
import shutil
def pre_build(**kwargs):
for file in glob.glob('../docs/*.md'):
shutil.copy(file, 'docs')
shutil.copy('../CHANGELOG.md', 'docs')

View File

@ -1,55 +0,0 @@
site_name: æternity Sophia Language
plugins:
- search
- mkdocs-simple-hooks:
hooks:
on_pre_build: 'hook:pre_build'
repo_url: 'https://github.com/aeternity/aesophia'
edit_uri: ''
extra:
version:
provider: mike
theme:
favicon: favicon.png
name: material
custom_dir: overrides
language: en
palette:
- scheme: default
primary: pink
accent: pink
toggle:
icon: material/weather-night
name: Switch to dark mode
- scheme: slate
primary: pink
accent: pink
toggle:
icon: material/weather-sunny
name: Switch to light mode
features:
- content.tabs.link
- search.highlight
- search.share
- search.suggest
# Don't include MkDocs' JavaScript
include_search_page: false
search_index_only: true
markdown_extensions:
- admonition
- pymdownx.highlight
- pymdownx.superfences
- toc:
toc_depth: 3
nav:
- Introduction: index.md
- Syntax: sophia_syntax.md
- Features: sophia_features.md
- Standard library: sophia_stdlib.md
- Contract examples: sophia_examples.md
- Changelog: CHANGELOG.md

View File

@ -1,8 +0,0 @@
{% extends "base.html" %}
{% block outdated %}
You're not viewing the latest version.
<a href="{{ '../' ~ base_url }}">
<strong>Click here to go to latest.</strong>
</a>
{% endblock %}

View File

@ -1,14 +0,0 @@
name: Sophia Tests
run-name: ${{ gitea.actor }} testing Sophia
on: [push, workflow_dispatch]
jobs:
tests:
runs-on: linux_amd64
steps:
- name: Check out repository code
uses: actions/checkout@v4
- name: test
run: |
. /home/act_runner/.erts/27.2.1/activate
./rebar3 eunit

6
.gitignore vendored
View File

@ -18,10 +18,6 @@ _build
rebar3.crashdump
*.erl~
*.aes~
sophia
aesophia
.qcci
current_counterexample.eqc
test/contracts/test.aes
__pycache__
.docssite/docs/*.md
.vscode

View File

@ -6,325 +6,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
## [Unreleased]
### Added
- Added a check for number of type variables in a type signature; it is serialized using 8 bits,
so the upper limit is 256.
### Changed
### Removed
## [9.0.0]
### Changed
- stdlib dir discovery now works by finding a relative path from the loaded Sophia installation
###Removed
- Oracles
## [8.0.1]
### Changed
- Upgrade aebytecode to v3.4.1 to fix C warnings
## [8.0.0]
### Added
- Bitwise operations for integers: `band`, `bor`, `bxor`, `bnot`, `<<` and `>>`.
- `Int.mulmod` - combined builtin operation for multiplication and modulus.
- `Crypto.poseidon` - a ZK/SNARK-friendly hash function (over the BLS12-381 scalar field).
- `Address.to_bytes` - convert an address to its binary representation (for hashing, etc.).
- Raw data pointers added to AENS. In short we have introduced a new namespace
`AENSv2`; they contain types similar to the old `AENS`; `AENS.name` and
`AENS.pointee`, where the latter now has a constructor `DataPt(bytes())`. All
AENS actions have been moved to `AENSv2`, and `AENSv2.lookup` and
`AENSv2.update` consume and produce the new types. The old `AENS` namespace
only contains the old datatypes, that can be used to interface existing
contracts. Standard library `AENSCompat` is added to convert between old and
new pointers.
- Introduce arbitrary sized binary arrays (type `bytes()`); adding `Bytes.split_any`,
`Bytes.to_fixed_size`, `Bytes.to_any_size`, `Bytes.size`, `String.to_bytes`,
and `Int.to_bytes`; and adjust `Bytes.concat` to allow both fixed and arbitrary
sized byte arrays.
- `Chain.network_id` - a function to get hold of the Chain's network id.
- Allowing `Bytes.to_any_size` in calldata creation, to enable creation of arguments
with arbitray size.
- Signature literals `sg_...` - they have type `signature` (which is an alias for `bytes(64)`).
- Support for OTP-27 - no changes in behavior.
### Changed
- `Crypto.verify_sig` is changed to have `msg : bytes()`. I.e. the
signed data can be of any length (used to be limited to `bytes(32)`/`hash`).
- System aliases are handled explicitly when converting to a Sophia value, this is only
observable for `signature` where a value of type `signature` is now represented as a
(new) signature literal.
- Allow self-qualification, i.e. referencing `X.foo` when in namespace `X`.
### Removed
- `Bitwise.aes` standard library is removed - the builtin operations are superior.
## [7.4.1]
### Changed
- Improve how includes with relative paths are resolved during parsing/compilation. Relative
include paths are now always relative to the file containing the `include` statement.
### Fixed
- Disable unused type warnings for types used inside of records.
## [7.4.0]
### Changed
- Names of lifted lambdas now consist of parent function's name and their
position in the source code.
### Fixed
- Lifted lambdas get their names assigned deterministically.
## [7.3.0]
### Fixed
- Fixed a bug with polymorphism that allowed functions with the same name but different type to be considered as implementations for their corresponding interface function.
- Fixed a bug in the byte code optimization that incorrectly reordered dependent instructions.
## [7.2.1]
### Fixed
- Fixed bugs with the newly added debugging symbols
## [7.2.0]
### Added
- Toplevel compile-time constants
```
namespace N =
let nc = 1
contract C =
let cc = 2
```
- API functions for encoding/decoding Sophia values to/from FATE.
### Removed
- Remove the mapping from variables to FATE registers from the compilation output.
### Fixed
- Warning about unused include when there is no include.
## [7.1.0]
### Added
- Options to enable/disable certain optimizations.
- The ability to call a different instance of the current contract
```
contract Main =
entrypoint spend(x : int) : int = x
entrypoint f(c : Main) : int = c.spend(10)
```
- Return a mapping from variables to FATE registers in the compilation output.
- Hole expression.
### Changed
- Type definitions serialised to ACI as `typedefs` field instead of `type_defs` to increase compatibility.
- Check contracts and entrypoints modifiers when implementing interfaces.
- Contracts can no longer be used as namespaces.
- Do not show unused stateful warning for functions that call other contracts with a non-zero value argument.
### Fixed
- Typechecker crashes if Chain.create or Chain.clone are used without arguments.
## [7.0.1]
### Added
- Add CONTRIBUTING.md file.
### Changed
- Update Sophia syntax docs to include missing information about existing syntax.
### Fixed
- [404](https://github.com/aeternity/aesophia/issues/404) Contract polymorphism crashes on non-obvious child contract typing.
## [7.0.0]
### Added
- Added support for `EXIT` opcode via `exit : (string) => 'a` function (behaves same as `ABORT`, but consumes all gas).
- Compiler warnings for the following: shadowing, negative spends, division by zero, unused functions, unused includes, unused stateful annotations, unused variables, unused parameters, unused user-defined type, dead return value.
- The pipe operator |>
```
[1, 2, 3] |> List.first |> Option.is_some // Option.is_some(List.first([1, 2, 3]))
```
- Allow binary operators to be used as lambdas
```
function sum(l : list(int)) : int = foldl((+), 0, l)
function logical_and(x, y) = (&&)(x, y)
```
- Contract interfaces polymorphism
### Changed
- Error messages have been restructured (less newlines) to provide more unified errors. Also `pp_oneline/1` has been added.
- Ban empty record definitions (e.g. `record r = {}` would give an error).
### Removed
- Support for AEVM has been entirely wiped
## [6.1.0] - 2021-10-20
### Added
- `Bitwise` stdlib
- `Set` stdlib
- `Option.force_msg`
- Loading namespaces into the current scope (e.g. `using Pair`)
- Assign patterns to variables (e.g. `let x::(t = y::_) = [1, 2, 3, 4]` where `t == [2, 3, 4]`)
- Add builtin types (`AENS.name, AENS.pointee, Chain.ttl, Chain.base_tx, Chain.ga_meta_tx, Chain.paying_for_tx`) to
the calldata and result decoder
- Patterns guards
```
switch(x)
a::[] | a > 10 => 1
_ => 2
```
```
function
f(a::[]) | a > 10 = 1
f(_) = 2
```
### Changed
- Fixed the ACI renderer, it shouldn't drop the `stateful` modifier
## [6.0.2] 2021-07-05
### Changed
- `List.from_to_step` now forbids non-positive step (this change does
*not* alter the behavior of the previously deployed contracts)
- Fixed leaking state between contracts
## [6.0.1] 2021-06-24
### Changed
- Fixed a bug in calldata encoding for contracts containing multiple contracts
- Fixed a missing `include` in the `Frac` standard library
## [6.0.0] 2021-05-26
### Added
- Child contracts
- `Chain.clone`
- `Chain.create`
- `Chain.bytecode_hash`
- Minor support for variadic functions
- `void` type that represents an empty type
- `Call.fee` builtin
### Changed
- Contract interfaces must be now invocated by `contract interface` keywords
- `main` keyword to indicate the main contract in case there are child contracts around
- `List.sum` and `List.product` no longer use `List.foldl`
### Removed
## [5.0.0] 2021-04-30
### Added
- A new and improved [`String` standard library](https://github.com/aeternity/aesophia/blob/master/docs/sophia_stdlib.md#string)
has been added. Use it by `include "String.aes"`. It includes functions for
turning strings into lists of characters for detailed manipulation. For
example:
```
include "String.aes"
contract C =
entrypoint filter_all_a(s: string) : string =
String.from_list(List.filter((c : char) => c != 'a', String.to_list(s)))
```
will return a list with all `a`'s removed.
There are also convenience functions `split`, `concat`, `to_upper`,
`to_lower`, etc.
All String functions in FATEv2 operate on unicode code points.
- Operations for pairing-based cryptography has been added the operations
are in the standard library [BLS12_381](https://github.com/aeternity/aesophia/blob/master/docs/sophia_stdlib.md#bls12_381).
With these operations it is possible to do Zero Knowledge-proofs, etc.
The operations are for the BLS12-381 curve (as the name suggests).
- Calls to functions in other contracts (i.e. _remote calls_) can now be
[`protected`](https://github.com/aeternity/aesophia/blob/master/docs/sophia.md#protected-contract-calls).
If a contract call fails for any reason (for instance, the remote contract
crashes or runs out of gas, or the entrypoint doesn't exist or has the
wrong type) the parent call also fails. To make it possible to recover
from failures, contract calls takes a named argument `protected : bool`
(default `false`).
If `protected = true` the result of the contract call is wrapped in an
`option`, and `Some(value)` indicates a succesful execution and `None`
indicates that the contract call failed. Note: any gas consumed until
the failure is still charged, but all side effects in the remote
contract are rolled back on failure.
- A new chain operation [`AENS.update`](https://github.com/aeternity/aesophia/blob/master/docs/sophia.md#aens-interface)
is supported.
- New chain exploring operations `AENS.lookup` and `Oracle.expiry` to
look up an AENS record and the expiry of an Oracle respectively, are added.
- Transaction introspection (`Auth.tx`) has been added. When a Generalized
account is authorized, the authorization function needs access to the
transaction (and the transaction hash) for the wrapped transaction. The
transaction and the transaction hash is available `Auth.tx`, it is only
available during authentication if invoked by a normal contract call
it returns `None`. Example:
```
switch(Auth.tx)
None => abort("Not in Auth context")
Some(tx0) =>
switch(tx0.tx)
Chain.SpendTx(_, amount, _) => amount > 400
Chain.ContractCallTx(_, _) => true
_ => false
```
- A debug mode is a added to the compiler. Right now its only use is to
turn off hermetization.
### Changed
- The function `Chain.block_hash(height)` is now (in FATEv2) defined for
the current height - this used to be an error.
- Standard library: Sort is optimized to do `mergesort` and a `contains`
function is added.
- Improved type errors and explicit errors for some syntax errors (empty code
blocks, etc.).
- Compiler optimization: The ACI is generated alongside bytecode. This means
that multiple compiler passes can be avoided.
- Compiler optimization: Improved parsing (less stack used when transpiled).
- A bug where constraints were handled out of order fixed.
- Fixed calldata decoding for singleton records.
- Improved the documentation w.r.t. signatures, especially stressing the fact that
the network ID is a part of what is signed.
### Removed
## [4.3.0]
### Added
- Added documentation (moved from `protocol`)
- `Frac.aes` library for rational numbers
- Added some more meaningful error messages
- Exported several parsing functionalities
- With option `keep_included` it is possible to see which files were included during the parse
- There is a function `run_parser` that be used to evaluate any parsing rule
- Exported parsers: `body`, `type` and `decl`
### Changed
- Performance improvements in the standard library
- Fixed ACI encoder to handle `-` unary operator
- Fixed including by absolute path
- Fixed variant type printing in the ACI error messages
- Fixed pretty printing of combined function clauses
### Removed
- `let` definitions are no longer supported in the toplevel of the contract
- type declarations are no longer supported
## [4.2.0] - 2020-01-15
### Added
- Allow separate entrypoint/function type signature and definition, and pattern
matching in left-hand sides:
```
function
length : list('a) => int
length([]) = 0
length(x :: xs) = 1 + length(xs)
```
- Allow pattern matching in list comprehension generators (filtering out match
failures):
```
function somes(xs : list(option('a))) : list('a) =
[ x | Some(x) <- xs ]
```
- Allow pattern matching in let-bindings (aborting on match failures):
```
function test(m : map(int, int)) =
let Some(x) = Map.lookup(m, 0)
x
```
### Changed
- FATE code generator improvements.
- Bug fix: Handle qualified constructors in patterns.
- Bug fix: Allow switching also on negative numbers.
### Removed
## [4.1.0] - 2019-11-26
### Added
- Support encoding and decoding bit fields in call arguments and results.
### Changed
- Various improvements to FATE code generator.
### Removed
## [4.0.0] - 2019-10-11
### Added
- `Address.to_contract` - casts an address to a (any) contract type.
- Pragma to check compiler version, e.g. `@compiler >= 4.0`.
- Handle numeric escapes, i.e. `"\x19Ethereum Signed Message:\n"`, and similar strings.
- `Bytes.concat` and `Bytes.split` are added to be able to
(de-)construct byte arrays.
- `[a..b]` language construct, returning the list of numbers between
- Added the `[a..b]` language construct, returning the list of numbers between
`a` and `b` (inclusive). Returns the empty list if `a` > `b`.
- [Standard libraries](https://github.com/aeternity/aesophia/blob/master/docs/sophia_stdlib.md)
- Checks that `init` is not called from other functions.
### Changed
### Removed
## [4.0.0-rc1] - 2019-08-22
### Added
- FATE backend - the compiler is able to produce VM code for both `AEVM` and `FATE`. Many
of the APIs now take `{backend, aevm | fate}` to decide wich backend to produce artifacts
for.
@ -341,20 +29,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
that shall be able to receive funds should be marked as payable. `Address.is_payable(a)`
can be used to check if an (contract) address is payable or not.
### Changed
- Nice type error if contract function is called as from a namespace.
- Fail on function definitions in contracts other than the main contract.
- Bug fix in variable optimization - don't discard writes to the store/state.
- Bug fixes in error reporting.
- Bug fix in variable liveness analysis for FATE.
- Error messages are changed into a uniform format, and more helpful
messages have been added.
- `Crypto.<hash_fun>` and `String.<hash_fun>` for byte arrays now only
hash the actual byte array - not the internal ABI format.
- More strict checks for polymorphic oracles and higher order oracles
and entrypoints.
- `AENS.claim` is updated with a `NameFee` field - to be able to do
name auctions within contracts.
- Fixed a bug in `Bytes.to_str` for AEVM.
- New syntax for tuple types. Now 0-tuple type is encoded as `unit` instead of `()` and
regular tuples are encoded by interspersing inner types with `*`, for instance `int * string`.
Parens are not necessary. Note it only affects the types, values remain as their were before,
@ -462,26 +136,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Simplify calldata creation - instead of passing a compiled contract, simply
pass a (stubbed) contract string.
[Unreleased]: https://github.com/aeternity/aesophia/compare/v8.0.1...HEAD
[8.0.1]: https://github.com/aeternity/aesophia/compare/v8.0.0...v8.0.1
[8.0.0]: https://github.com/aeternity/aesophia/compare/v7.4.1...v8.0.0
[7.4.1]: https://github.com/aeternity/aesophia/compare/v7.4.0...v7.4.1
[7.4.0]: https://github.com/aeternity/aesophia/compare/v7.3.0...v7.4.0
[7.3.0]: https://github.com/aeternity/aesophia/compare/v7.2.1...v7.3.0
[7.2.1]: https://github.com/aeternity/aesophia/compare/v7.2.0...v7.2.1
[7.2.0]: https://github.com/aeternity/aesophia/compare/v7.1.0...v7.2.0
[7.1.0]: https://github.com/aeternity/aesophia/compare/v7.0.1...v7.1.0
[7.0.1]: https://github.com/aeternity/aesophia/compare/v7.0.0...v7.0.1
[7.0.0]: https://github.com/aeternity/aesophia/compare/v6.1.0...v7.0.0
[6.1.0]: https://github.com/aeternity/aesophia/compare/v6.0.2...v6.1.0
[6.0.2]: https://github.com/aeternity/aesophia/compare/v6.0.1...v6.0.2
[6.0.1]: https://github.com/aeternity/aesophia/compare/v6.0.0...v6.0.1
[6.0.0]: https://github.com/aeternity/aesophia/compare/v5.0.0...v6.0.0
[5.0.0]: https://github.com/aeternity/aesophia/compare/v4.3.0...v5.0.0
[4.3.0]: https://github.com/aeternity/aesophia/compare/v4.2.0...v4.3.0
[4.2.0]: https://github.com/aeternity/aesophia/compare/v4.1.0...v4.2.0
[4.1.0]: https://github.com/aeternity/aesophia/compare/v4.0.0...v4.1.0
[4.0.0]: https://github.com/aeternity/aesophia/compare/v3.2.0...v4.0.0
[Unreleased]: https://github.com/aeternity/aesophia/compare/v4.0.0-rc1...HEAD
[4.0.0-rc1]: https://github.com/aeternity/aesophia/compare/v3.2.0...v4.0.0-rc1
[3.2.0]: https://github.com/aeternity/aesophia/compare/v3.1.0...v3.2.0
[3.1.0]: https://github.com/aeternity/aesophia/compare/v3.0.0...v3.1.0
[3.0.0]: https://github.com/aeternity/aesophia/compare/v2.1.0...v3.0.0

View File

@ -1,40 +0,0 @@
# Contributing to Sophia
## Checklist For Creating New Pull Requests
The following points should be considered before creating a new PR to the Sophia compiler.
### Documentation
- The [Changelog](CHANGELOG.md) file should be updated for all PRs.
- If a PR introduces a new feature that is relevant to the users of the language, the [Sophia Features Documentation](docs/sophia_features.md) should be updated to describe the new feature.
- If a PR introduces new syntax (e.g. changes in [aeso_syntax.erl](src/aeso_syntax.erl), [aeso_scan.erl](src/aeso_scan.erl), or [aeso_parser.erl](src/aeso_parser.erl)), the [Sophia Syntax Documentation](docs/sophia_syntax.md) should be updated to include the new syntax.
- If a PR introduces a new library, the public interface of the new library should be fully documented in the [Sophia Standard Library Documentation](docs/sophia_stdlib.md).
- If a PR introduces a new compiler option, the new option should be documented in the file
[aeso_compiler.md](docs/aeso_compiler.md).
### Tests
- If a PR introduces new syntax (e.g. changes in [aeso_syntax.erl](src/aeso_syntax.erl), [aeso_scan.erl](src/aeso_scan.erl), or [aeso_parser.erl](src/aeso_parser.erl)), the contract [all_syntax.aes](test/contracts/all_syntax.aes) should be updated to include the new syntax.
- If a PR fixes a bug, the code that replicates the bug should be added as a new passing test contract.
- If a PR introduces a new feature, add tests for both successful and failing usage of that feature. In order to run the entire compilation pipeline and to avoid erroring during intermediate steps, failing tests should not be mixed with the successful ones.
### Source Code
- If a PR introduces new syntax (e.g. changes in [aeso_syntax.erl](src/aeso_syntax.erl), [aeso_scan.erl](src/aeso_scan.erl), or [aeso_parser.erl](src/aeso_parser.erl)), the following code should be updated to handle the new syntax:
- The function `aeso_syntax_utils:fold/4` in the file [aeso_syntax_utils.erl](src/aeso_syntax_utils.erl).
- Any related pretty printing function in the file [aeso_pretty.erl](src/aeso_pretty.erl), depending on the type of the newly added syntax.
## Checklist For Creating a Release
- Update the version in the file [aesophia.app.src](src/aesophia.app.src).
- Update the version in the file [rebar.config](rebar.config).
- In the [Changelog](CHANGELOG.md):
- Update the `Unreleased` changes to be under the new version.
- Update the version at the bottom of the file.
- Commit and the changes and create a new PR (check the commit of [v6.1.0](https://github.com/aeternity/aesophia/commit/5ad5270e381f6e810d7b8b5cdc168d283e7a90bb) for reference).
- Create a release after merging the new PR to `master` branch.
- After releasing `aesophia`, refer to each of the following repositories and create new releases as well, using the new `aesophia` release:
- [aesophia_cli](https://github.com/aeternity/aesophia_cli)
- [aesophia_http](https://github.com/aeternity/aesophia_http)
- [aerepl](https://github.com/aeternity/aerepl)

View File

@ -1 +0,0 @@
{"src/*", [debug_info, {i, "include/"}, {outdir, "ebin/"}]}.

View File

@ -1,7 +1,6 @@
ISC License
Copyright (c) 2025, QPQ AG
Copyright (c) 2017, æternity developers
Copyright (c) 2017, aeternity developers
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above

View File

@ -1,35 +1,25 @@
# The Sophia smart contract language
# aesophia
This is the __sophia__ compiler which compiles contracts written in __sophia__ to [FATE](https://git.qpq.swiss/QPQ-AG/protocol/src/branch/master/contracts/fate.md) instructions.
This is the __sophia__ compiler for the æternity system which compiles contracts written in __sophia__ code to the æternity VM code.
The compiler is currently being used three places
- [The command line compiler](https://git.qpq.swiss/QPQ-AG/sophia_cli)
- [Desktop wallet](https://git.qpq.swiss/QPQ-AG/GajuDesk)
- In the [Gajumaru core node](https://git.qpq.swiss/QPQ-AG/gajumaru) tests
For more information about æternity smart contracts and the sophia language see [Smart Contracts](https://github.com/aeternity/protocol/blob/master/contracts/contracts.md) and the [Sophia Language](https://github.com/aeternity/protocol/blob/master/contracts/sophia.md).
## Documentation
* [Introduction](docs/index.md)
* [Syntax](docs/sophia_syntax.md)
* [Features](docs/sophia_features.md)
* [Standard library](docs/sophia_stdlib.md)
* [Contract examples](docs/sophia_examples.md)
* [Contributing](CONTRIBUTING.md)
Additionally you can check out the [contracts section](https://git.qpq.swiss/QPQ-AG/protocol/src/branch/master/contracts) of the Gajumaru blockchain specification.
It is an OTP application written in Erlang and is by default included in
[the æternity node](https://github.com/aeternity/epoch). However, it can
also be included in other systems to compile contracts coded in sophia which
can then be loaded into the æternity system.
## Versioning
Versioning should follow the [semantic versioning](https://semver.org/spec/v2.0.0) guidelines. Id est, given a version number MAJOR.MINOR.PATCH, increment the:
- MAJOR version when you make incompatible API changes
- MINOR version when you add functionality in a backwards compatible manner
- PATCH version when you make backwards compatible bug fixes
`aesophia` has a version that is only loosely connected to the version of the
Aeternity node - in principle they will share the major version but not
minor/patch version. The `aesophia` compiler version MUST be bumped whenever
there is a change in how byte code is generated, but it MAY also be bumped upon
API changes etc.
## Interface Modules
The basic modules for interfacing the compiler:
* [so_compiler: the Sophia compiler](docs/so_compiler.md)
* [so_aci: the ACI interface](docs/so_aci.md)
* [aeso_compiler: the Sophia compiler](./docs/aeso_compiler.md)
* [aeso_aci: the ACI interface](./docs/aeso_aci.md)

View File

@ -1,8 +1,8 @@
# so_aci
# aeso_aci
### Module
### so_aci
### aeso_aci
The ACI interface encoder and decoder.
@ -67,7 +67,7 @@ generates the following JSON structure representing the contract interface:
}
]
},
"typedefs": [
"type_defs": [
{
"name": "answers",
"typedef": {
@ -123,7 +123,7 @@ be included inside another contract.
``` erlang
1> {ok,Contract} = file:read_file("aci_test.aes").
{ok,<<"contract Answers =\n record state = { a : answers }\n type answers() = map(string, int)\n\n stateful function"...>>}
2> {ok,JsonACI} = so_aci:contract_interface(json, Contract).
2> {ok,JsonACI} = aeso_aci:contract_interface(json, Contract).
{ok,[#{contract =>
#{functions =>
[#{arguments => [],name => <<"init">>,
@ -138,13 +138,13 @@ be included inside another contract.
state =>
#{record =>
[#{name => <<"a">>,type => <<"Answers.answers">>}]},
typedefs =>
type_defs =>
[#{name => <<"answers">>,
typedef => #{<<"map">> => [<<"string">>,<<"int">>]},
vars => []}]}}]}
3> file:write_file("aci_test.aci", jsx:encode(JsonACI)).
ok
4> {ok,InterfaceStub} = so_aci:render_aci_json(JsonACI).
4> {ok,InterfaceStub} = aeso_aci:render_aci_json(JsonACI).
{ok,<<"contract Answers =\n record state = {a : Answers.answers}\n type answers = map(string, int)\n function init "...>>}
5> file:write_file("aci_test.include", InterfaceStub).
ok

View File

@ -1,8 +1,8 @@
# so_compiler
# aeso_compiler
### Module
### so_compiler
### aeso_compiler
The Sophia compiler
@ -49,35 +49,11 @@ The **pp_** options all print to standard output the following:
`pp_typed_ast` - print the AST with type information at each node
`pp_icode` - print the internal code structure
`pp_assembler` - print the generated assembler code
The option `include_child_contract_symbols` includes the symbols of child contracts functions in the generated fate code. It is turned off by default to avoid making contracts bigger on chain.
#### Options to control which compiler optimizations should run:
By default all optimizations are turned on, to disable an optimization, it should be
explicitly set to false and passed as a compiler option.
List of optimizations:
- optimize_inliner
- optimize_inline_local_functions
- optimize_bind_subexpressions
- optimize_let_floating
- optimize_simplifier
- optimize_drop_unused_lets
- optimize_push_consume
- optimize_one_shot_var
- optimize_write_to_dead_var
- optimize_inline_switch_target
- optimize_swap_push
- optimize_swap_pop
- optimize_swap_write
- optimize_constant_propagation
- optimize_prune_impossible_branches
- optimize_single_successful_branch
- optimize_inline_store
- optimize_float_switch_bod
`pp_bytecode` - print the bytecode instructions
#### check_call(ContractString, Options) -> CheckRet
@ -90,6 +66,15 @@ Type = term()
```
Check a call in contract through the `__call` function.
#### sophia_type_to_typerep(String) -> TypeRep
Types
``` erlang
{ok,TypeRep} | {error, badtype}
```
Get the type representation of a type declaration.
#### version() -> {ok, Version} | {error, term()}
Types

View File

@ -1,9 +0,0 @@
# Introduction
Sophia is a functional language designed for smart contract development.
It is strongly typed and has restricted mutable state.
Sophia is customized for smart contracts, which can be published to a blockchain.
Thus some features of conventional languages (such as floating point arithmetic) are not present in Sophia,
and some blockchain specific primitives, constructions and types have been added.
The file extension used for Sophia source files is ".aes", reflecting Sophia's Aeternity heritage.

View File

@ -1 +0,0 @@
This file has been moved [here](sophia_features.md)

View File

@ -1,67 +0,0 @@
# Contract examples
## Crowdfunding
```sophia
/*
* A simple crowd-funding example
*/
contract FundMe =
record spend_args = { recipient : address,
amount : int }
record state = { contributions : map(address, int),
total : int,
beneficiary : address,
deadline : int,
goal : int }
stateful function spend(args : spend_args) =
Chain.spend(args.recipient, args.amount)
entrypoint init(beneficiary, deadline, goal) : state =
{ contributions = {},
beneficiary = beneficiary,
deadline = deadline,
total = 0,
goal = goal }
function is_contributor(addr) =
Map.member(addr, state.contributions)
stateful entrypoint contribute() =
if(Chain.block_height >= state.deadline)
spend({ recipient = Call.caller, amount = Call.value }) // Refund money
false
else
let amount =
switch(Map.lookup(Call.caller, state.contributions))
None => Call.value
Some(n) => n + Call.value
put(state{ contributions[Call.caller] = amount,
total @ tot = tot + Call.value })
true
stateful entrypoint withdraw() =
if(Chain.block_height < state.deadline)
abort("Cannot withdraw before deadline")
if(Call.caller == state.beneficiary)
withdraw_beneficiary()
elif(is_contributor(Call.caller))
withdraw_contributor()
else
abort("Not a contributor or beneficiary")
stateful function withdraw_beneficiary() =
require(state.total >= state.goal, "Project was not funded")
spend({recipient = state.beneficiary,
amount = Contract.balance })
stateful function withdraw_contributor() =
if(state.total >= state.goal)
abort("Project was funded")
let to = Call.caller
spend({recipient = to,
amount = state.contributions[to]})
put(state{ contributions @ c = Map.delete(to, c) })
```

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,292 +0,0 @@
# Syntax
## Lexical syntax
### Comments
Single line comments start with `//` and block comments are enclosed in `/*`
and `*/` and can be nested.
### Keywords
```
contract include let switch type record datatype if elif else function
stateful payable true false mod public entrypoint private indexed namespace
interface main using as for hiding
```
### Tokens
- `Id = [a-z_][A-Za-z0-9_']*` identifiers start with a lower case letter.
- `Con = [A-Z][A-Za-z0-9_']*` constructors start with an upper case letter.
- `QId = (Con\.)+Id` qualified identifiers (e.g. `Map.member`)
- `QCon = (Con\.)+Con` qualified constructor
- `TVar = 'Id` type variable (e.g `'a`, `'b`)
- `Int = [0-9]+(_[0-9]+)*|0x[0-9A-Fa-f]+(_[0-9A-Fa-f]+)*` integer literal with optional `_` separators
- `Bytes = #[0-9A-Fa-f]+(_[0-9A-Fa-f]+)*` byte array literal with optional `_` separators
- `String` string literal enclosed in `"` with escape character `\`
- `Char` character literal enclosed in `'` with escape character `\`
- `AccountAddress` base58-encoded 32 byte account pubkey with `ak_` prefix
- `ContractAddress` base58-encoded 32 byte contract address with `ct_` prefix
- `Signature` base58-encoded 64 byte cryptographic signature with `sg_` prefix
Valid string escape codes are
| Escape | ASCII | |
|---------------|-------------|---|
| `\b` | 8 | |
| `\t` | 9 | |
| `\n` | 10 | |
| `\v` | 11 | |
| `\f` | 12 | |
| `\r` | 13 | |
| `\e` | 27 | |
| `\xHexDigits` | *HexDigits* | |
See the [identifier encoding scheme](https://git.qpq.swiss/QPQ-AG/protocol/src/branch/master/node/api/api_encoding.md) for the
details on the base58 literals.
## Layout blocks
Sophia uses Python-style layout rules to group declarations and statements. A
layout block with more than one element must start on a separate line and be
indented more than the currently enclosing layout block. Blocks with a single
element can be written on the same line as the previous token.
Each element of the block must share the same indentation and no part of an
element may be indented less than the indentation of the block. For instance
```sophia
contract Layout =
function foo() = 0 // no layout
function bar() = // layout block starts on next line
let x = foo() // indented more than 2 spaces
x
+ 1 // the '+' is indented more than the 'x'
```
## Notation
In describing the syntax below, we use the following conventions:
- Upper-case identifiers denote non-terminals (like `Expr`) or terminals with
some associated value (like `Id`).
- Keywords and symbols are enclosed in single quotes: `'let'` or `'='`.
- Choices are separated by vertical bars: `|`.
- Optional elements are enclosed in `[` square brackets `]`.
- `(` Parentheses `)` are used for grouping.
- Zero or more repetitions are denoted by a postfix `*`, and one or more
repetitions by a `+`.
- `Block(X)` denotes a layout block of `X`s.
- `Sep(X, S)` is short for `[X (S X)*]`, i.e. a possibly empty sequence of `X`s
separated by `S`s.
- `Sep1(X, S)` is short for `X (S X)*`, i.e. same as `Sep`, but must not be empty.
## Declarations
A Sophia file consists of a sequence of *declarations* in a layout block.
```c
File ::= Block(TopDecl)
TopDecl ::= ['payable'] ['main'] 'contract' Con [Implement] '=' Block(Decl)
| 'contract' 'interface' Con [Implement] '=' Block(Decl)
| 'namespace' Con '=' Block(Decl)
| '@compiler' PragmaOp Version
| 'include' String
| Using
Implement ::= ':' Sep1(Con, ',')
Decl ::= 'type' Id ['(' TVar* ')'] '=' TypeAlias
| 'record' Id ['(' TVar* ')'] '=' RecordType
| 'datatype' Id ['(' TVar* ')'] '=' DataType
| 'let' Id [':' Type] '=' Expr
| (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
| Using
FunDecl ::= Id ':' Type // Type signature
| Id Args [':' Type] '=' Block(Stmt) // Definition
| Id Args [':' Type] Block(GuardedDef) // Guarded definitions
GuardedDef ::= '|' Sep1(Expr, ',') '=' Block(Stmt)
Using ::= 'using' Con ['as' Con] [UsingParts]
UsingParts ::= 'for' '[' Sep1(Id, ',') ']'
| 'hiding' '[' Sep1(Id, ',') ']'
PragmaOp ::= '<' | '=<' | '==' | '>=' | '>'
Version ::= Sep1(Int, '.')
EModifier ::= 'payable' | 'stateful'
FModifier ::= 'stateful' | 'private'
Args ::= '(' Sep(Pattern, ',') ')'
```
Contract declarations must appear at the top-level.
For example,
```sophia
contract Test =
type t = int
entrypoint add (x : t, y : t) = x + y
```
There are three forms of type declarations: type aliases (declared with the
`type` keyword), record type definitions (`record`) and data type definitions
(`datatype`):
```c
TypeAlias ::= Type
RecordType ::= '{' Sep(FieldType, ',') '}'
DataType ::= Sep1(ConDecl, '|')
FieldType ::= Id ':' Type
ConDecl ::= Con ['(' Sep1(Type, ',') ')']
```
For example,
```sophia
record point('a) = {x : 'a, y : 'a}
datatype shape('a) = Circle(point('a), 'a) | Rect(point('a), point('a))
type int_shape = shape(int)
```
## Types
```c
Type ::= Domain '=>' Type // Function type
| Type '(' Sep(Type, ',') ')' // Type application
| '(' Type ')' // Parens
| 'unit' | Sep(Type, '*') // Tuples
| Id | QId | TVar
Domain ::= Type // Single argument
| '(' Sep(Type, ',') ')' // Multiple arguments
```
The function type arrow associates to the right.
Example,
```sophia
'a => list('a) => (int * list('a))
```
## Statements
Function bodies are blocks of *statements*, where a statement is one of the following
```c
Stmt ::= 'switch' '(' Expr ')' Block(Case)
| 'if' '(' Expr ')' Block(Stmt)
| 'elif' '(' Expr ')' Block(Stmt)
| 'else' Block(Stmt)
| 'let' LetDef
| Using
| Expr
LetDef ::= Id Args [':' Type] '=' Block(Stmt) // Function definition
| Pattern '=' Block(Stmt) // Value definition
Case ::= Pattern '=>' Block(Stmt)
| Pattern Block(GuardedCase)
GuardedCase ::= '|' Sep1(Expr, ',') '=>' Block(Stmt)
Pattern ::= Expr
```
`if` statements can be followed by zero or more `elif` statements and an optional final `else` statement. For example,
```sophia
let x : int = 4
switch(f(x))
None => 0
Some(y) =>
if(y > 10)
"too big"
elif(y < 3)
"too small"
else
"just right"
```
## Expressions
```c
Expr ::= '(' LamArgs ')' '=>' Block(Stmt) // Anonymous function (x) => x + 1
| '(' BinOp ')' // Operator lambda (+)
| 'if' '(' Expr ')' Expr 'else' Expr // If expression if(x < y) y else x
| Expr ':' Type // Type annotation 5 : int
| Expr BinOp Expr // Binary operator x + y
| UnOp Expr // Unary operator ! b
| Expr '(' Sep(Expr, ',') ')' // Application f(x, y)
| Expr '.' Id // Projection state.x
| Expr '[' Expr ']' // Map lookup map[key]
| Expr '{' Sep(FieldUpdate, ',') '}' // Record or map update r{ fld[key].x = y }
| '[' Sep(Expr, ',') ']' // List [1, 2, 3]
| '[' Expr '|' Sep(Generator, ',') ']'
// List comprehension [k | x <- [1], if (f(x)), let k = x+1]
| '[' Expr '..' Expr ']' // List range [1..n]
| '{' Sep(FieldUpdate, ',') '}' // Record or map value {x = 0, y = 1}, {[key] = val}
| '(' Expr ')' // Parens (1 + 2) * 3
| '(' Expr '=' Expr ')' // Assign pattern (y = x::_)
| Id | Con | QId | QCon // Identifiers x, None, Map.member, AELib.Token
| Int | Bytes | String | Char // Literals 123, 0xff, #00abc123, "foo", '%'
| AccountAddress | ContractAddress // Chain identifiers
| Signature // Signature
| '???' // Hole expression 1 + ???
Generator ::= Pattern '<-' Expr // Generator
| 'if' '(' Expr ')' // Guard
| LetDef // Definition
LamArgs ::= '(' Sep(LamArg, ',') ')'
LamArg ::= Id [':' Type]
FieldUpdate ::= Path '=' Expr
Path ::= Id // Record field
| '[' Expr ']' // Map key
| Path '.' Id // Nested record field
| Path '[' Expr ']' // Nested map key
BinOp ::= '||' | '&&' | '<' | '>' | '=<' | '>=' | '==' | '!='
| '::' | '++' | '+' | '-' | '*' | '/' | 'mod' | '^'
| 'band' | 'bor' | 'bxor' | '<<' | '>>' | '|>'
UnOp ::= '-' | '!' | 'bnot'
```
## Operators types
| Operators | Type
| --- | ---
| `-` `+` `*` `/` `mod` `^` | arithmetic operators
| `!` `&&` `\|\|` | logical operators
| `band` `bor` `bxor` `bnot` `<<` `>>` | bitwise operators
| `==` `!=` `<` `>` `=<` `>=` | comparison operators
| `::` `++` | list operators
| `\|>` | functional operators
## Operator precedence
In order of highest to lowest precedence.
| Operators | Associativity
| --- | ---
| `!` `bnot`| right
| `^` | left
| `*` `/` `mod` | left
| `-` (unary) | right
| `+` `-` | left
| `<<` `>>` | left
| `::` `++` | right
| `<` `>` `=<` `>=` `==` `!=` | none
| `band` | left
| `bxor` | left
| `bor` | left
| `&&` | right
| `\|\|` | right
| `\|>` | left

View File

@ -1,27 +0,0 @@
-define(LET_P(X, P, Q), so_parse_lib:bind(P, fun(X) -> Q end)).
-define(LAZY_P(P), so_parse_lib:lazy(fun() -> P end)).
-define(MEMO_P(P), so_parse_lib:lazy(so_parse_lib:memoised(fun() -> P end))).
-define(GUARD_P(G, P),
case G of
true -> P;
false -> fail()
end).
-define(RULE(A, Do), map(fun(_1) -> Do end, A )).
-define(RULE(A, B, Do), map(fun({_1, _2}) -> Do end, {A, B} )).
-define(RULE(A, B, C, Do), map(fun({_1, _2, _3}) -> Do end, {A, B, C} )).
-define(RULE(A, B, C, D, Do), map(fun({_1, _2, _3, _4}) -> Do end, {A, B, C, D} )).
-define(RULE(A, B, C, D, E, Do), map(fun({_1, _2, _3, _4, _5}) -> Do end, {A, B, C, D, E} )).
-define(RULE(A, B, C, D, E, F, Do), map(fun({_1, _2, _3, _4, _5, _6}) -> Do end, {A, B, C, D, E, F} )).
-define(RULE(A, B, C, D, E, F, G, Do), map(fun({_1, _2, _3, _4, _5, _6, _7}) -> Do end, {A, B, C, D, E, F, G} )).
-define(RULE(A, B, C, D, E, F, G, H, Do), map(fun({_1, _2, _3, _4, _5, _6, _7, _8}) -> Do end, {A, B, C, D, E, F, G, H})).
-import(so_parse_lib,
[tok/1, tok/2, between/3, many/1, many1/1, sep/2, sep1/2,
infixl/1, infixr/1, choice/1, choice/2, return/1, layout/0,
fail/0, fail/1, fail/2, map/2, infixl/2, infixr/2, infixl1/2, infixr1/2,
left/2, right/2, optional/1]).

View File

@ -1,6 +0,0 @@
-define(IS_CONTRACT_HEAD(X),
(X =:= contract_main orelse
X =:= contract_interface orelse
X =:= contract_child
)
).

View File

@ -1,17 +0,0 @@
namespace AENSCompat =
// Translate old format to new format - always possible
function pointee_to_V2(p : AENS.pointee) : AENSv2.pointee =
switch(p)
AENS.AccountPt(a) => AENSv2.AccountPt(a)
AENS.OraclePt(a) => AENSv2.OraclePt(a)
AENS.ContractPt(a) => AENSv2.ContractPt(a)
AENS.ChannelPt(a) => AENSv2.ChannelPt(a)
// Translate new format to old format - option type!
function pointee_from_V2(p2 : AENSv2.pointee) : option(AENS.pointee) =
switch(p2)
AENSv2.AccountPt(a) => Some(AENS.AccountPt(a))
AENSv2.OraclePt(a) => Some(AENS.OraclePt(a))
AENSv2.ContractPt(a) => Some(AENS.ContractPt(a))
AENSv2.ChannelPt(a) => Some(AENS.ChannelPt(a))
AENSv2.DataPt(_) => None

View File

@ -1,68 +0,0 @@
namespace BLS12_381 =
type fr = MCL_BLS12_381.fr
type fp = MCL_BLS12_381.fp
record fp2 = { x1 : fp, x2 : fp }
record g1 = { x : fp, y : fp, z : fp }
record g2 = { x : fp2, y : fp2, z : fp2 }
record gt = { x1 : fp, x2 : fp, x3 : fp, x4 : fp, x5 : fp, x6 : fp,
x7 : fp, x8 : fp, x9 : fp, x10 : fp, x11 : fp, x12 : fp }
function pairing_check(us : list(g1), vs : list(g2)) =
switch((us, vs))
([], []) => true
(x :: xs, y :: ys) => pairing_check_(pairing(x, y), xs, ys)
function pairing_check_(acc : gt, us : list(g1), vs : list(g2)) =
switch((us, vs))
([], []) => gt_is_one(acc)
(x :: xs, y :: ys) =>
pairing_check_(gt_mul(acc, pairing(x, y)), xs, ys)
function int_to_fr(x : int) = MCL_BLS12_381.int_to_fr(x)
function int_to_fp(x : int) = MCL_BLS12_381.int_to_fp(x)
function fr_to_int(x : fr) = MCL_BLS12_381.fr_to_int(x)
function fp_to_int(x : fp) = MCL_BLS12_381.fp_to_int(x)
function mk_g1(x : int, y : int, z : int) : g1 =
{ x = int_to_fp(x), y = int_to_fp(y), z = int_to_fp(z) }
function mk_g2(x1 : int, x2 : int, y1 : int, y2 : int, z1 : int, z2 : int) : g2 =
{ x = {x1 = int_to_fp(x1), x2 = int_to_fp(x2)},
y = {x1 = int_to_fp(y1), x2 = int_to_fp(y2)},
z = {x1 = int_to_fp(z1), x2 = int_to_fp(z2)} }
function pack_g1(t) = switch(t)
(x, y, z) => {x = x, y = y, z = z} : g1
function pack_g2(t) = switch(t)
((x1, x2), (y1, y2), (z1, z2)) =>
{x = {x1 = x1, x2 = x2}, y = {x1 = y1, x2 = y2}, z = {x1 = z1, x2 = z2}} : g2
function pack_gt(t) = switch(t)
(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) =>
{x1 = x1, x2 = x2, x3 = x3, x4 = x4, x5 = x5, x6 = x6,
x7 = x7, x8 = x8, x9 = x9, x10 = x10, x11 = x11, x12 = x12} : gt
function g1_neg(p : g1) = pack_g1(MCL_BLS12_381.g1_neg((p.x, p.y, p.z)))
function g1_norm(p : g1) = pack_g1(MCL_BLS12_381.g1_norm((p.x, p.y, p.z)))
function g1_valid(p : g1) = MCL_BLS12_381.g1_valid((p.x, p.y, p.z))
function g1_is_zero(p : g1) = MCL_BLS12_381.g1_is_zero((p.x, p.y, p.z))
function g1_add(p : g1, q : g1) = pack_g1(MCL_BLS12_381.g1_add((p.x, p.y, p.z), (q.x, q.y, q.z)))
function g1_mul(k : fr, p : g1) = pack_g1(MCL_BLS12_381.g1_mul(k, (p.x, p.y, p.z)))
function g2_neg(p : g2) = pack_g2(MCL_BLS12_381.g2_neg(((p.x.x1, p.x.x2), (p.y.x1, p.y.x2), (p.z.x1, p.z.x2))))
function g2_norm(p : g2) = pack_g2(MCL_BLS12_381.g2_norm(((p.x.x1, p.x.x2), (p.y.x1, p.y.x2), (p.z.x1, p.z.x2))))
function g2_valid(p : g2) = MCL_BLS12_381.g2_valid(((p.x.x1, p.x.x2), (p.y.x1, p.y.x2), (p.z.x1, p.z.x2)))
function g2_is_zero(p : g2) = MCL_BLS12_381.g2_is_zero(((p.x.x1, p.x.x2), (p.y.x1, p.y.x2), (p.z.x1, p.z.x2)))
function g2_add(p : g2, q : g2) = pack_g2(MCL_BLS12_381.g2_add(((p.x.x1, p.x.x2), (p.y.x1, p.y.x2), (p.z.x1, p.z.x2)),
((q.x.x1, q.x.x2), (q.y.x1, q.y.x2), (q.z.x1, q.z.x2))))
function g2_mul(k : fr, p : g2) = pack_g2(MCL_BLS12_381.g2_mul(k, ((p.x.x1, p.x.x2), (p.y.x1, p.y.x2), (p.z.x1, p.z.x2))))
function gt_inv(p : gt) = pack_gt(MCL_BLS12_381.gt_inv((p.x1, p.x2, p.x3, p.x4, p.x5, p.x6, p.x7, p.x8, p.x9, p.x10, p.x11, p.x12)))
function gt_add(p : gt, q : gt) = pack_gt(MCL_BLS12_381.gt_add((p.x1, p.x2, p.x3, p.x4, p.x5, p.x6, p.x7, p.x8, p.x9, p.x10, p.x11, p.x12),
(q.x1, q.x2, q.x3, q.x4, q.x5, q.x6, q.x7, q.x8, q.x9, q.x10, q.x11, q.x12)))
function gt_mul(p : gt, q : gt) = pack_gt(MCL_BLS12_381.gt_mul((p.x1, p.x2, p.x3, p.x4, p.x5, p.x6, p.x7, p.x8, p.x9, p.x10, p.x11, p.x12),
(q.x1, q.x2, q.x3, q.x4, q.x5, q.x6, q.x7, q.x8, q.x9, q.x10, q.x11, q.x12)))
function gt_pow(p : gt, k : fr) = pack_gt(MCL_BLS12_381.gt_pow((p.x1, p.x2, p.x3, p.x4, p.x5, p.x6, p.x7, p.x8, p.x9, p.x10, p.x11, p.x12), k))
function gt_is_one(p : gt) = MCL_BLS12_381.gt_is_one((p.x1, p.x2, p.x3, p.x4, p.x5, p.x6, p.x7, p.x8, p.x9, p.x10, p.x11, p.x12))
function pairing(p : g1, q : g2) = pack_gt(MCL_BLS12_381.pairing((p.x, p.y, p.z), ((q.x.x1, q.x.x2), (q.y.x1, q.y.x2), (q.z.x1, q.z.x2))))
function miller_loop(p : g1, q : g2) = pack_gt(MCL_BLS12_381.miller_loop((p.x, p.y, p.z), ((q.x.x1, q.x.x2), (q.y.x1, q.y.x2), (q.z.x1, q.z.x2))))
function final_exp(p : gt) = pack_gt(MCL_BLS12_381.final_exp((p.x1, p.x2, p.x3, p.x4, p.x5, p.x6, p.x7, p.x8, p.x9, p.x10, p.x11, p.x12)))

View File

@ -1,185 +0,0 @@
include "String.aes"
namespace Frac =
private function gcd(a : int, b : int) =
if (b == 0) a else gcd(b, a mod b)
private function abs_int(a : int) = if (a < 0) -a else a
datatype frac = Pos(int, int) | Zero | Neg(int, int)
/** Checks if the internal representation is correct.
* Numerator and denominator must be positive.
* Exposed for debug purposes
*/
function is_sane(f : frac) : bool = switch(f)
Pos(n, d) => n > 0 && d > 0
Zero => true
Neg(n, d) => n > 0 && d > 0
function num(f : frac) : int = switch(f)
Pos(n, _) => n
Neg(n, _) => -n
Zero => 0
function den(f : frac) : int = switch(f)
Pos(_, d) => d
Neg(_, d) => d
Zero => 1
function to_pair(f : frac) : int * int = switch(f)
Pos(n, d) => (n, d)
Neg(n, d) => (-n, d)
Zero => (0, 1)
function sign(f : frac) : int = switch(f)
Pos(_, _) => 1
Neg(_, _) => -1
Zero => 0
function to_str(f : frac) : string = switch(f)
Pos(n, d) => String.concat(Int.to_str(n), if (d == 1) "" else String.concat("/", Int.to_str(d)))
Neg(n, d) => String.concat("-", to_str(Pos(n, d)))
Zero => "0"
/** Reduce fraction to normal form
*/
function simplify(f : frac) : frac =
switch(f)
Neg(n, d) =>
let cd = gcd(n, d)
Neg(n / cd, d / cd)
Zero => Zero
Pos(n, d) =>
let cd = gcd(n, d)
Pos(n / cd, d / cd)
/** Integer to rational division
*/
function make_frac(n : int, d : int) : frac =
if (d == 0) abort("Zero denominator")
elif (n == 0) Zero
elif ((n < 0) == (d < 0)) simplify(Pos(abs_int(n), abs_int(d)))
else simplify(Neg(abs_int(n), abs_int(d)))
function one() : frac = Pos(1, 1)
function zero() : frac = Zero
function eq(a : frac, b : frac) : bool =
let (na, da) = to_pair(a)
let (nb, db) = to_pair(b)
(na == nb && da == db) || na * db == nb * da // they are more likely to be normalized
function neq(a : frac, b : frac) : bool =
let (na, da) = to_pair(a)
let (nb, db) = to_pair(b)
(na != nb || da != db) && na * db != nb * da
function geq(a : frac, b : frac) : bool = num(a) * den(b) >= num(b) * den(a)
function leq(a : frac, b : frac) : bool = num(a) * den(b) =< num(b) * den(a)
function gt(a : frac, b : frac) : bool = num(a) * den(b) > num(b) * den(a)
function lt(a : frac, b : frac) : bool = num(a) * den(b) < num(b) * den(a)
function min(a : frac, b : frac) : frac = if (leq(a, b)) a else b
function max(a : frac, b : frac) : frac = if (geq(a, b)) a else b
function abs(f : frac) : frac = switch(f)
Pos(n, d) => Pos(n, d)
Zero => Zero
Neg(n, d) => Pos(n, d)
function from_int(n : int) : frac =
if (n > 0) Pos(n, 1)
elif (n < 0) Neg(-n, 1)
else Zero
function floor(f : frac) : int = switch(f)
Pos(n, d) => n / d
Zero => 0
Neg(n, d) => -(n + d - 1) / d
function ceil(f : frac) : int = switch(f)
Pos(n, d) => (n + d - 1) / d
Zero => 0
Neg(n, d) => -n / d
function round_to_zero(f : frac) : int = switch(f)
Pos(n, d) => n / d
Zero => 0
Neg(n, d) => -n / d
function round_from_zero(f : frac) : int = switch(f)
Pos(n, d) => (n + d - 1) / d
Zero => 0
Neg(n, d) => -(n + d - 1) / d
/** Round towards nearest integer. If two integers are in the same
* distance, choose the even one.
*/
function round(f : frac) : int =
let fl = floor(f)
let cl = ceil(f)
let dif_fl = abs(sub(f, from_int(fl)))
let dif_cl = abs(sub(f, from_int(cl)))
if (gt(dif_fl, dif_cl)) cl
elif (gt(dif_cl, dif_fl)) fl
elif (fl mod 2 == 0) fl
else cl
function add(a : frac, b : frac) : frac =
let (na, da) = to_pair(a)
let (nb, db) = to_pair(b)
if (da == db) make_frac(na + nb, da)
else make_frac(na * db + nb * da, da * db)
function neg(a : frac) : frac = switch(a)
Neg(n, d) => Pos(n, d)
Zero => Zero
Pos(n, d) => Neg(n, d)
function sub(a : frac, b : frac) : frac = add(a, neg(b))
function inv(a : frac) : frac = switch(a)
Neg(n, d) => Neg(d, n)
Zero => abort("Inversion of zero")
Pos(n, d) => Pos(d, n)
function mul(a : frac, b : frac) : frac = make_frac(num(a) * num(b), den(a) * den(b))
function div(a : frac, b : frac) : frac = switch(b)
Neg(n, d) => mul(a, Neg(d, n))
Zero => abort("Division by zero")
Pos(n, d) => mul(a, Pos(d, n))
/** `b` to the power of `e`
*/
function int_exp(b : frac, e : int) : frac =
if (sign(b) == 0 && e == 0) abort("Zero to the zero exponentation")
elif (e < 0) inv(int_exp_(b, -e))
else int_exp_(b, e)
private function int_exp_(b : frac, e : int) =
if (e == 0) from_int(1)
elif (e == 1) b
else
let half = int_exp_(b, e / 2)
if (e mod 2 == 1) mul(mul(half, half), b)
else mul(half, half)
/** Reduces the fraction's in-memory size by dividing its components by two until the
* the error is bigger than `loss` value
*/
function optimize(f : frac, loss : frac) : frac =
require(geq(loss, Zero), "negative loss optimize")
let s = sign(f)
mul(from_int(s), run_optimize(abs(f), abs(f), loss))
private function run_optimize(orig : frac, f : frac, loss : frac) : frac =
let (n, d) = to_pair(f)
let t = make_frac((n+1)/2, (d+1)/2)
if(gt(abs(sub(t, orig)), loss)) f
elif (eq(t, f)) f
else run_optimize(orig, t, loss)

View File

@ -2,7 +2,7 @@ namespace Func =
function id(x : 'a) : 'a = x
function const(x : 'a) : 'b => 'a = (_) => x
function const(x : 'a) : 'b => 'a = (y) => x
function flip(f : ('a, 'b) => 'c) : ('b, 'a) => 'c = (b, a) => f(a, b)
@ -12,66 +12,35 @@ namespace Func =
function rapply(x : 'a, f : 'a => 'b) : 'b = f(x)
/** The Z combinator - replacement for local and anonymous recursion.
*/
/* The Z combinator - replacement for local and anonymous recursion.
*/
function recur(f : ('arg => 'res, 'arg) => 'res) : 'arg => 'res =
(x) => f(recur(f), x)
/** n-times composition with itself
*/
function iter(n : int, f : 'a => 'a) : 'a => 'a = iter_(n, f, (x) => x)
private function iter_(n : int, f : 'a => 'a, acc : 'a => 'a) : 'a => 'a =
if(n == 0) acc
elif(n == 1) comp(f, acc)
else iter_(n / 2, comp(f, f), if(n mod 2 == 0) acc else comp(f, acc))
/** Turns an ugly, bad and disgusting arity-n function into
* a beautiful and sweet function taking the first argument
* and returning a function watiting for the remaining ones
* in the same manner
*/
function curry2(f : ('a, 'b) => 'x) : 'a => ('b => 'x) =
function curry2(f : ('a, 'b) => 'c) : 'a => ('b => 'c) =
(x) => (y) => f(x, y)
function curry3(f : ('a, 'b, 'c) => 'x) : 'a => ('b => ('c => 'x)) =
function curry3(f : ('a, 'b, 'c) => 'd) : 'a => ('b => ('c => 'd)) =
(x) => (y) => (z) => f(x, y, z)
function curry4(f : ('a, 'b, 'c, 'd) => 'x) : 'a => ('b => ('c => ('d => 'x))) =
(x) => (y) => (z) => (w) => f(x, y, z, w)
function curry5(f : ('a, 'b, 'c, 'd, 'e) => 'x) : 'a => ('b => ('c => ('d => ('e => 'x)))) =
(x) => (y) => (z) => (w) => (q) => f(x, y, z, w, q)
/** Opposite of curry. Gross
*/
function uncurry2(f : 'a => ('b => 'x)) : ('a, 'b) => 'x =
function uncurry2(f : 'a => ('b => 'c)) : ('a, 'b) => 'c =
(x, y) => f(x)(y)
function uncurry3(f : 'a => ('b => ('c => 'x))) : ('a, 'b, 'c) => 'x =
function uncurry3(f : 'a => ('b => ('c => 'd))) : ('a, 'b, 'c) => 'd =
(x, y, z) => f(x)(y)(z)
function uncurry4(f : 'a => ('b => ('c => ('d => 'x)))) : ('a, 'b, 'c, 'd) => 'x =
(x, y, z, w) => f(x)(y)(z)(w)
function uncurry5(f : 'a => ('b => ('c => ('d => ('e => 'x))))) : ('a, 'b, 'c, 'd, 'e) => 'x =
(x, y, z, w, q) => f(x)(y)(z)(w)(q)
/** Turns an arity-n function into a function taking n-tuple
*/
function tuplify2(f : ('a, 'b) => 'x) : (('a * 'b)) => 'x =
function tuplify2(f : ('a, 'b) => 'c) : (('a * 'b)) => 'c =
(t) => switch(t)
(x, y) => f(x, y)
function tuplify3(f : ('a, 'b, 'c) => 'x) : 'a * 'b * 'c => 'x =
function tuplify3(f : ('a, 'b, 'c) => 'd) : 'a * 'b * 'c => 'd =
(t) => switch(t)
(x, y, z) => f(x, y, z)
function tuplify4(f : ('a, 'b, 'c, 'd) => 'x) : 'a * 'b * 'c * 'd => 'x =
(t) => switch(t)
(x, y, z, w) => f(x, y, z, w)
function tuplify5(f : ('a, 'b, 'c, 'd, 'e) => 'x) : 'a * 'b * 'c * 'd * 'e => 'x =
(t) => switch(t)
(x, y, z, w, q) => f(x, y, z, w, q)
/** Opposite of tuplify
*/
function untuplify2(f : 'a * 'b => 'x) : ('a, 'b) => 'x =
function untuplify2(f : 'a * 'b => 'c) : ('a, 'b) => 'c =
(x, y) => f((x, y))
function untuplify3(f : 'a * 'b * 'c => 'x) : ('a, 'b, 'c) => 'x =
function untuplify3(f : 'a * 'b * 'c => 'd) : ('a, 'b, 'c) => 'd =
(x, y, z) => f((x, y, z))
function untuplify4(f : 'a * 'b * 'c * 'd => 'x) : ('a, 'b, 'c, 'd) => 'x =
(x, y, z, w) => f((x, y, z, w))
function untuplify5(f : 'a * 'b * 'c * 'd * 'e => 'x) : ('a, 'b, 'c, 'd, 'e) => 'x =
(x, y, z, w, q) => f((x, y, z, w, q))

View File

@ -15,53 +15,31 @@ namespace List =
_::t => Some(t)
function last(l : list('a)) : option('a) = switch(l)
[] => None
[x] => Some(x)
[] => None
[x] => Some(x)
_::t => last(t)
function drop_last(l : list('a)) : option(list('a)) = switch(l)
[] => None
_ => Some(drop_last_unsafe(l))
function drop_last_unsafe(l : list('a)) : list('a) = switch(l)
[_] => []
h::t => h::drop_last_unsafe(t)
[] => abort("drop_last_unsafe: list empty")
function contains(e : 'a, l : list('a)) = switch(l)
[] => false
h::t => h == e || contains(e, t)
/** Finds first element of `l` fulfilling predicate `p` as `Some` or `None`
* if no such element exists.
*/
function find(p : 'a => bool, l : list('a)) : option('a) = switch(l)
[] => None
h::t => if(p(h)) Some(h) else find(p, t)
/** Returns list of all indices of elements from `l` that fulfill the predicate `p`.
*/
function find_indices(p : 'a => bool, l : list('a)) : list(int) = find_indices_(p, l, 0)
function find_indices(p : 'a => bool, l : list('a)) : list(int) = find_indices_(p, l, 0, [])
private function find_indices_( p : 'a => bool
, l : list('a)
, n : int
, acc : list(int)
) : list(int) = switch(l)
[] => []
h::t =>
let rest = find_indices_(p, t, n+1)
if(p(h)) n::rest else rest
[] => reverse(acc)
h::t => find_indices_(p, t, n+1, if(p(h)) n::acc else acc)
function nth(n : int, l : list('a)) : option('a) =
switch(l)
[] => None
h::t => if(n == 0) Some(h) else nth(n-1, t)
function nth(n : int, l : list('a)) : option('a) = switch(l)
[] => None
h::t => if(n == 0) Some(h) else nth(n-1, t)
/* Unsafe version of `nth` */
function get(n : int, l : list('a)) : 'a =
switch(l)
[] => abort(if(n < 0) "Negative index get" else "Out of index get")
h::t => if(n == 0) h else get(n-1, t)
function get(n : int, l : list('a)) : 'a = switch(l)
[] => abort("Out of index get")
h::t => if(n == 0) h else get(n-1, t)
function length(l : list('a)) : int = length_(l, 0)
@ -70,55 +48,32 @@ namespace List =
_::t => length_(t, acc + 1)
/** Creates an ascending sequence of all integer numbers
* between `a` and `b` (including `a` and `b`)
*/
function from_to(a : int, b : int) : list(int) = [a..b]
/** Creates an ascending sequence of integer numbers betweeen
* `a` and `b` jumping by given `step`. Includes `a` and takes
* `b` only if `(b - a) mod step == 0`. `step` should be bigger than 0.
*/
function from_to_step(a : int, b : int, s : int) : list(int) =
require(s > 0, "List.from_to_step: non-positive step")
from_to_step_(a, b - (b-a) mod s, s, [])
private function from_to_step_(a : int, b : int, s : int, acc : list(int)) : list(int) =
if(b < a) acc
else from_to_step_(a, b - s, s, b::acc)
/** Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow
*/
/* Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow */
function replace_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else replace_at_(n, e, l)
private function replace_at_(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else replace_at_(n, e, l, [])
private function replace_at_(n : int, e : 'a, l : list('a), acc : list('a)) : list('a) =
switch(l)
[] => abort("replace_at overflow")
h::t => if (n == 0) e::t
else h::replace_at_(n-1, e, t)
h::t => if (n == 0) reverse(e::acc) ++ t
else replace_at_(n-1, e, t, h::acc)
/** Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow
*/
/* Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow */
function insert_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else insert_at_(n, e, l)
private function insert_at_(n : int, e : 'a, l : list('a)) : list('a) =
if (n == 0) e::l
if(n<0) abort("insert_at underflow") else insert_at_(n, e, l, [])
private function insert_at_(n : int, e : 'a, l : list('a), acc : list('a)) : list('a) =
if (n == 0) reverse(e::acc) ++ l
else switch(l)
[] => abort("insert_at overflow")
h::t => h::insert_at_(n-1, e, t)
h::t => insert_at_(n-1, e, t, h::acc)
/** Assuming that cmp represents `<` comparison, inserts `x` before
* the first element in the list `l` which is greater than it
*/
function insert_by(cmp : (('a, 'a) => bool), x : 'a, l : list('a)) : list('a) =
function insert_by(f : (('a, 'a) => bool), x : 'a, l : list('a)) : list('a) =
switch(l)
[] => [x]
h::t =>
if(cmp(x, h)) // x < h
x::l
[] => [x]
(e :: l') =>
if(f(x, e))
e :: insert_by(f, x, l')
else
h::insert_by(cmp, x, t)
x :: l
function foldr(cons : ('a, 'b) => 'b, nil : 'b, l : list('a)) : 'b = switch(l)
[] => nil
@ -128,78 +83,68 @@ namespace List =
[] => acc
h::t => foldl(rcons, rcons(acc, h), t)
function foreach(l : list('a), f : 'a => unit) : unit =
function foreach(f : 'a => unit, l : list('a)) : unit =
switch(l)
[] => ()
e::l' =>
[] => ()
e :: l' =>
f(e)
foreach(l', f)
foreach(f, l')
function reverse(l : list('a)) : list('a) = reverse_(l, [])
private function reverse_(l : list('a), acc : list('a)) : list('a) = switch(l)
[] => acc
h::t => reverse_(t, h::acc)
function reverse(l : list('a)) : list('a) = foldl((lst, el) => el :: lst, [], l)
function map(f : 'a => 'b, l : list('a)) : list('b) = switch(l)
[] => []
h::t => f(h)::map(f, t)
function map(f : 'a => 'b, l : list('a)) : list('b) = map_(f, l, [])
private function map_(f : 'a => 'b, l : list('a), acc : list('b)) : list('b) = switch(l)
[] => reverse(acc)
h::t => map_(f, t, f(h)::acc)
/** Effectively composition of `map` and `flatten`
*/
function flat_map(f : 'a => list('b), l : list('a)) : list('b) =
ListInternal.flat_map(f, l)
function filter(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t =>
let rest = filter(p, t)
if(p(h)) h::rest else rest
function filter(p : 'a => bool, l : list('a)) : list('a) = filter_(p, l, [])
private function filter_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => filter_(p, t, if(p(h)) h::acc else acc)
/** Take up to `n` first elements
*/
/* Take `n` first elements */
function take(n : int, l : list('a)) : list('a) =
if(n < 0) abort("Take negative number of elements") else take_(n, l)
private function take_(n : int, l : list('a)) : list('a) =
if(n == 0) []
if(n < 0) abort("Take negative number of elements") else take_(n, l, [])
private function take_(n : int, l : list('a), acc : list('a)) : list('a) =
if(n == 0) reverse(acc)
else switch(l)
[] => []
h::t => h::take_(n-1, t)
[] => reverse(acc)
h::t => take_(n-1, t, h::acc)
/** Drop up to `n` first elements
*/
/* Drop `n` first elements */
function drop(n : int, l : list('a)) : list('a) =
if(n < 0) abort("Drop negative number of elements") else drop_(n, l)
private function drop_(n : int, l : list('a)) : list('a) =
if (n == 0) l
if(n < 0) abort("Drop negative number of elements")
elif (n == 0) l
else switch(l)
[] => []
_::t => drop_(n-1, t)
h::t => drop(n-1, t)
/** Get the longest prefix of a list in which every element
* matches predicate `p`
*/
function take_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => if(p(h)) h::take_while(p, t) else []
/* Get the longest prefix of a list in which every element matches predicate `p` */
function take_while(p : 'a => bool, l : list('a)) : list('a) = take_while_(p, l, [])
private function take_while_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => if(p(h)) take_while_(p, t, h::acc) else reverse(acc)
/** Drop elements from `l` until `p` holds
*/
/* Drop elements from `l` until `p` holds */
function drop_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => if(p(h)) drop_while(p, t) else l
/** Splits list into two lists of elements that respectively
* match and don't match predicate `p`
*/
function partition(p : 'a => bool, lst : list('a)) : (list('a) * list('a)) = switch(lst)
[] => ([], [])
h::t =>
let (l, r) = partition(p, t)
if(p(h)) (h::l, r) else (l, h::r)
/* Splits list into two lists of elements that respectively match and don't match predicate `p` */
function partition(p : 'a => bool, l : list('a)) : (list('a) * list('a)) = partition_(p, l, [], [])
private function partition_( p : 'a => bool
, l : list('a)
, acc_t : list('a)
, acc_f : list('a)
) : (list('a) * list('a)) = switch(l)
[] => (reverse(acc_t), reverse(acc_f))
h::t => if(p(h)) partition_(p, t, h::acc_t, acc_f) else partition_(p, t, acc_t, h::acc_f)
function flatten(l : list(list('a))) : list('a) = switch(l)
[] => []
h::t => h ++ flatten(t)
function concats(ll : list(list('a))) : list('a) = foldr((l1, l2) => l1 ++ l2, [], ll)
function all(p : 'a => bool, l : list('a)) : bool = switch(l)
[] => true
@ -209,108 +154,49 @@ namespace List =
[] => false
h::t => if(p(h)) true else any(p, t)
function sum(l : list(int)) : int = switch(l)
[] => 0
h::t => h + sum(t)
function sum(l : list(int)) : int = foldl ((a, b) => a + b, 0, l)
function product(l : list(int)) : int = switch(l)
[] => 1
h::t => h * sum(t)
function product(l : list(int)) : int = foldl((a, b) => a * b, 1, l)
/** Zips two list by applying bimapping function on respective elements.
* Drops the tail of the longer list.
*/
private function zip_with( f : ('a, 'b) => 'c
/* Zips two list by applying bimapping function on respective elements. Drops longer tail. */
function zip_with(f : ('a, 'b) => 'c, l1 : list('a), l2 : list('b)) : list('c) = zip_with_(f, l1, l2, [])
private function zip_with_( f : ('a, 'b) => 'c
, l1 : list('a)
, l2 : list('b)
, acc : list('c)
) : list('c) = switch ((l1, l2))
(h1::t1, h2::t2) => f(h1, h2)::zip_with(f, t1, t2)
_ => []
(h1::t1, h2::t2) => zip_with_(f, t1, t2, f(h1, h2)::acc)
_ => reverse(acc)
/** Zips two lists into list of pairs.
* Drops the tail of the longer list.
*/
/* Zips two lists into list of pairs. Drops longer tail. */
function zip(l1 : list('a), l2 : list('b)) : list('a * 'b) = zip_with((a, b) => (a, b), l1, l2)
function unzip(l : list('a * 'b)) : (list('a) * list('b)) = switch(l)
[] => ([], [])
(h1, h2)::t =>
let (t1, t2) = unzip(t)
(h1::t1, h2::t2)
function unzip(l : list('a * 'b)) : list('a) * list('b) = unzip_(l, [], [])
private function unzip_( l : list('a * 'b)
, acc_l : list('a)
, acc_r : list('b)
) : (list('a) * list('b)) = switch(l)
[] => (reverse(acc_l), reverse(acc_r))
(left, right)::t => unzip_(t, left::acc_l, right::acc_r)
/** Merges two sorted lists using `lt` comparator
*/
function
merge : (('a, 'a) => bool, list('a), list('a)) => list('a)
merge(lt, x::xs, y::ys) =
if(lt(x, y)) x::merge(lt, xs, y::ys)
else y::merge(lt, x::xs, ys)
merge(_, [], ys) = ys
merge(_, xs, []) = xs
/** Mergesort inspired by
* https://hackage.haskell.org/package/base-4.14.1.0/docs/src/Data.OldList.html#sort
*/
function
sort : (('a, 'a) => bool, list('a)) => list('a)
sort(_, []) = []
sort(lt, l) =
merge_all(lt, monotonic_subs(lt, l))
/** Splits list into compound increasing sublists
*/
private function
monotonic_subs : (('a, 'a) => bool, list('a)) => list(list('a))
monotonic_subs(lt, x::y::rest) =
if(lt(y, x)) desc(lt, y, [x], rest)
else asc(lt, y, [x], rest)
monotonic_subs(_, l) = [l]
/** Extracts the longest descending prefix and proceeds with monotonic split
*/
private function
desc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a))
desc(lt, x, acc, h::t) =
if(lt(x, h)) (x::acc) :: monotonic_subs(lt, h::t)
else desc(lt, h, x::acc, t)
desc(_, x, acc, []) = [x::acc]
/** Extracts the longest ascending prefix and proceeds with monotonic split
*/
private function
asc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a))
asc(lt, x, acc, h::t) =
if(lt(h, x)) reverse(x::acc) :: monotonic_subs(lt, h::t)
else asc(lt, h, x::acc, t)
asc(_, x, acc, []) = [reverse(x::acc)]
/** Merges list of sorted lists
*/
private function
merge_all : (('a, 'a) => bool, list(list('a))) => list('a)
merge_all(_, [part]) = part
merge_all(lt, parts) = merge_all(lt, merge_pairs(lt, parts))
/** Single round of `merge_all` pairs of lists in a list of list
*/
private function
merge_pairs : (('a, 'a) => bool, list(list('a))) => list(list('a))
merge_pairs(lt, x::y::rest) = merge(lt, x, y) :: merge_pairs(lt, rest)
merge_pairs(_, l) = l
/** Puts `delim` between every two members of the list
*/
function intersperse(delim : 'a, l : list('a)) : list('a) = switch(l)
// TODO: Improve?
function sort(lesser_cmp : ('a, 'a) => bool, l : list('a)) : list('a) = switch(l)
[] => []
[e] => [e]
h::t => h::delim::intersperse(delim, t)
h::t => switch (partition((x) => lesser_cmp(x, h), t))
(lesser, bigger) => sort(lesser_cmp, lesser) ++ h::sort(lesser_cmp, bigger)
function intersperse(delim : 'a, l : list('a)) : list('a) = intersperse_(delim, l, [])
private function intersperse_(delim : 'a, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
[e] => reverse(e::acc)
h::t => intersperse_(delim, t, delim::h::acc)
function enumerate(l : list('a)) : list(int * 'a) = enumerate_(l, 0, [])
private function enumerate_(l : list('a), n : int, acc : list(int * 'a)) : list(int * 'a) = switch(l)
[] => reverse(acc)
h::t => enumerate_(t, n + 1, (n, h)::acc)
/** Effectively a zip with an infinite sequence of natural numbers
*/
function enumerate(l : list('a)) : list(int * 'a) = enumerate_(l, 0)
private function enumerate_(l : list('a), n : int) : list(int * 'a) = switch(l)
[] => []
h::t => (n, h)::enumerate_(t, n + 1)

View File

@ -2,8 +2,8 @@ namespace ListInternal =
// -- Flatmap ----------------------------------------------------------------
function flat_map(f : 'a => list('b), lst : list('a)) : list('b) =
switch(lst)
function flat_map(f : 'a => list('b), xs : list('a)) : list('b) =
switch(xs)
[] => []
x :: xs => f(x) ++ flat_map(f, xs)

View File

@ -1,3 +1,5 @@
include "List.aes"
namespace Option =
function is_none(o : option('a)) : bool = switch(o)
@ -8,31 +10,16 @@ namespace Option =
None => false
Some(_) => true
/** Catamorphism on `option`. Also known as inlined pattern matching.
*/
function match(n : 'b, s : 'a => 'b, o : option('a)) : 'b = switch(o)
None => n
Some(x) => s(x)
/** Escape option providing default if `None`
*/
function default(def : 'a, o : option('a)) : 'a = match(def, (x) => x, o)
/** Assume it is `Some`
*/
function force(o : option('a)) : 'a = switch(o)
None => abort("Forced None value")
Some(x) => x
function force(o : option('a)) : 'a = default(abort("Forced None value"), o)
/** Assume it is `Some` with custom error message
*/
function force_msg(o : option('a), err : string) : 'a = switch(o)
None => abort(err)
Some(x) => x
function contains(e : 'a, o : option('a)) = o == Some(e)
function on_elem(o : option('a), f : 'a => unit) : unit = match((), f, o)
function on_elem(f : 'a => unit, o : option('a)) : unit = match((), f, o)
function map(f : 'a => 'b, o : option('a)) : option('b) = switch(o)
None => None
@ -53,14 +40,10 @@ namespace Option =
(Some(x1), Some(x2), Some(x3)) => Some(f(x1, x2, x3))
_ => None
/** Like `map`, but the function is in `option`
*/
function app_over(f : option ('a => 'b), o : option('a)) : option('b) = switch((f, o))
(Some(ff), Some(xx)) => Some(ff(xx))
_ => None
/** Monadic bind
*/
function flat_map(f : 'a => option('b), o : option('a)) : option('b) = switch(o)
None => None
Some(x) => f(x)
@ -70,33 +53,24 @@ namespace Option =
None => []
Some(x) => [x]
/** Turns list of options into a list of elements that are under `Some`s.
* Safe.
*/
function filter_options(l : list(option('a))) : list('a) = switch(l)
[] => []
None::t => filter_options(t)
Some(x)::t => x::filter_options(t)
function filter_options(l : list(option('a))) : list('a) = filter_options_(l, [])
private function filter_options_(l : list (option('a)), acc : list('a)) : list('a) = switch(l)
[] => List.reverse(acc)
None::t => filter_options_(t, acc)
Some(x)::t => filter_options_(t, x::acc)
/** Just like `filter_options` but requires all elements to be `Some` and returns
* None if any of them is not
*/
function seq_options(l : list (option('a))) : option (list('a)) = switch(l)
[] => Some([])
None::_ => None
Some(x)::t => switch(seq_options(t))
None => None
Some(st) => Some(x::st)
function seq_options(l : list (option('a))) : option (list('a)) = seq_options_(l, [])
private function seq_options_(l : list (option('a)), acc : list('a)) : option(list('a)) = switch(l)
[] => Some(List.reverse(acc))
None::t => None
Some(x)::t => seq_options_(t, x::acc)
/** Choose `Some` out of two if possible
*/
function choose(o1 : option('a), o2 : option('a)) : option('a) =
if(is_some(o1)) o1 else o2
/** Choose `Some` from list of options if possible
*/
function choose_first(l : list(option('a))) : option('a) = switch(l)
[] => None
None::t => choose_first(t)
Some(x)::_ => Some(x)

View File

@ -6,18 +6,12 @@ namespace Pair =
function snd(t : ('a * 'b)) : 'b = switch(t)
(_, y) => y
/** Map over first
*/
function map1(f : 'a => 'c, t : ('a * 'b)) : ('c * 'b) = switch(t)
(x, y) => (f(x), y)
/** Map over second
*/
function map2(f : 'b => 'c, t : ('a * 'b)) : ('a * 'c) = switch(t)
(x, y) => (x, f(y))
/** Map over both
*/
function bimap(f : 'a => 'c, g : 'b => 'd, t : ('a * 'b)) : ('c * 'd) = switch(t)
(x, y) => (f(x), g(y))

View File

@ -1,51 +0,0 @@
include "List.aes"
include "Option.aes"
include "Pair.aes"
namespace Set =
record set('a) = { to_map : map('a, unit) }
function new() : set('a) =
{ to_map = {} }
function member(e : 'a, s : set('a)) : bool =
Map.member(e, s.to_map)
function insert(e : 'a, s : set('a)) : set('a) =
{ to_map = s.to_map{[e] = ()} }
function delete(e : 'a, s : set('a)) : set('a) =
{ to_map = Map.delete(e, s.to_map) }
function size(s : set('a)) : int =
Map.size(s.to_map)
function to_list(s : set('a)) : list('a) =
List.map(Pair.fst, Map.to_list(s.to_map))
function from_list(l : list('a)) : set('a) =
{ to_map = Map.from_list(List.map((x) => (x, ()), l)) }
function filter(p : 'a => bool, s : set('a)) : set('a) =
from_list(List.filter(p, to_list(s)))
function fold(f : ('a, 'b) => 'b, acc : 'b, s : set('a)) : 'b =
List.foldr(f, acc, to_list(s))
function subtract(s1 : set('a), s2 : set('a)) : set('a) =
filter((x) => !member(x, s2), s1)
function intersection(s1 : set('a), s2 : set('a)) : set('a) =
filter((x) => member(x, s2), s1)
function intersection_list(sets : list(set('a))) : set('a) =
List.foldr(
intersection,
Option.default(new(), List.first(sets)),
Option.default([], List.tail(sets)))
function union(s1 : set('a), s2 : set('a)) : set('a) =
from_list(to_list(s1) ++ to_list(s2))
function union_list(sets : list(set('a))) : set('a) =
List.foldr(union, new(), sets)

View File

@ -1,120 +0,0 @@
include "List.aes"
namespace String =
// Gives a bytes() representation of the string
function to_bytes(s : string) : bytes() = StringInternal.to_bytes(s)
// Computes the SHA3/Keccak hash of the string
function sha3(s : string) : hash = StringInternal.sha3(s)
// Computes the SHA256 hash of the string.
function sha256(s : string) : hash = StringInternal.sha256(s)
// Computes the Blake2B hash of the string.
function blake2b(s : string) : hash = StringInternal.blake2b(s)
// The length of a string - equivalent to List.lenght(to_list(s))
function length(s : string) : int = StringInternal.length(s)
// Concatenates `s1` and `s2`.
function concat(s1 : string, s2 : string) : string = StringInternal.concat(s1, s2)
// Concatenates a list of strings.
function
concats : (list(string)) => string
concats([]) = ""
concats(s :: ss) = List.foldl(StringInternal.concat, s, ss)
// Converts a `string` to a list of `char` - the code points are normalized, but
// composite characters are possibly converted to multiple `char`s.
function from_list(cs : list(char)) : string = StringInternal.from_list(cs)
// Converts a list of characters into a normalized UTF-8 string.
function to_list(s : string) : list(char) = StringInternal.to_list(s)
// Converts a string to lowercase.
function to_lower(s : string) = StringInternal.to_lower(s)
// Converts a string to uppercase.
function to_upper(s : string) = StringInternal.to_upper(s)
// Splits a string at (zero-based) index `ix`.
function split(i : int, s : string) : string * string =
let cs = StringInternal.to_list(s)
(StringInternal.from_list(List.take(i, cs)), StringInternal.from_list(List.drop(i, cs)))
// Returns the character/codepoint at (zero-based) index `ix`.
function at(ix : int, s : string) =
switch(List.drop(ix, StringInternal.to_list(s)))
[] => None
x :: _ => Some(x)
// Searches for `pat` in `str`, returning `Some(ix)` if `pat` is a substring
// of `str` starting at position `ix`, otherwise returns `None`.
function contains(str : string, substr : string) : option(int) =
if(substr == "") Some(0)
else
contains_(0, StringInternal.to_list(str), StringInternal.to_list(substr))
// Splits `s` into tokens, `pat` is the divider of tokens.
function tokens(s : string, pat : string) =
require(pat != "", "String.tokens: empty pattern")
tokens_(StringInternal.to_list(pat), StringInternal.to_list(s), [])
// Converts a decimal ("123", "-253") or a hexadecimal ("0xa2f", "-0xBBB") string
// into an integer. If the string doesn't contain a valid number `None` is returned.
function to_int(str : string) : option(int) =
let lst = StringInternal.to_list(str)
switch(is_prefix(['-'], lst))
None => to_int_pos(lst)
Some(s) => switch(to_int_pos(s))
None => None
Some(x) => Some(-x)
// Private helper functions below
private function to_int_pos(chs : list(char)) =
switch(is_prefix(['0', 'x'], chs))
None =>
to_int_(chs, ch_to_int_10, 0, 10)
Some(str) =>
to_int_(str, ch_to_int_16, 0, 16)
private function
tokens_(_, [], acc) = [StringInternal.from_list(List.reverse(acc))]
tokens_(pat, str, acc) =
switch(is_prefix(pat, str))
Some(str') =>
StringInternal.from_list(List.reverse(acc)) :: tokens_(pat, str', [])
None =>
let c :: cs = str
tokens_(pat, cs, c :: acc)
private function
contains_(_, [], _) = None
contains_(ix, str, substr) =
switch(is_prefix(substr, str))
None =>
let _ :: tailstr = str
contains_(ix + 1, tailstr, substr)
Some(_) =>
Some(ix)
private function
is_prefix([], ys) = Some(ys)
is_prefix(_, []) = None
is_prefix(x :: xs, y :: ys) =
if(x == y) is_prefix(xs, ys)
else None
private function
to_int_([], _, x, _) = Some(x)
to_int_(i :: is, value, x, b) =
switch(value(i))
None => None
Some(n) => to_int_(is, value, x * b + n, b)
private function ch_to_int_10(ch) =
let c = Char.to_int(ch)
if(c >= 48 && c =< 57) Some(c - 48)
else None
private function ch_to_int_16(ch) =
let c = Char.to_int(ch)
if(c >= 48 && c =< 57) Some(c - 48)
elif(c >= 65 && c =< 70) Some(c - 55)
elif(c >= 97 && c =< 102) Some(c - 87)
else None

View File

@ -10,23 +10,15 @@ namespace Triple =
(_, _, z) => z
/** Map over first
*/
function map1(f : 'a => 'm, t : ('a * 'b * 'c)) : ('m * 'b * 'c) = switch(t)
(x, y, z) => (f(x), y, z)
/** Map over second
*/
function map2(f : 'b => 'm, t : ('a * 'b * 'c)) : ('a * 'm * 'c) = switch(t)
(x, y, z) => (x, f(y), z)
/** Map over third
*/
function map3(f : 'c => 'm, t : ('a * 'b * 'c)) : ('a * 'b * 'm) = switch(t)
(x, y, z) => (x, y, f(z))
/** Map over all elements
*/
function trimap( f : 'a => 'x
, g : 'b => 'y
, h : 'c => 'z
@ -37,13 +29,9 @@ namespace Triple =
function swap(t : ('a * 'b * 'c)) : ('c * 'b * 'a) = switch(t)
(x, y, z) => (z, y, x)
/** Right rotation
*/
function rotr(t : ('a * 'b * 'c)) : ('c * 'a * 'b) = switch(t)
(x, y, z) => (z, x, y)
/** Left rotation
*/
function rotl(t : ('a * 'b * 'c)) : ('b * 'c * 'a) = switch(t)
(x, y, z) => (y, z, x)

View File

@ -2,11 +2,11 @@
{erl_opts, [debug_info]}.
{deps, [ {gmbytecode,
{git, "https://git.qpq.swiss/QPQ-AG/gmbytecode.git",
{ref, "97cea33be8f3a35d26055664da7aa59531ff5537"}}}
{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {ref,"3f85375"}}}
, {getopt, "1.0.1"}
, {eblake2, "1.0.0"}
, {jsx, {git, "https://github.com/talentdeficit/jsx.git", {tag, "2.8.0"}}}
, {jsx, {git, "https://github.com/talentdeficit/jsx.git",
{tag, "2.8.0"}}}
]}.
{dialyzer, [
@ -15,11 +15,10 @@
{base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
]}.
{relx, [{release, {sophia, "9.0.0"},
[sophia, gmbytecode]},
{relx, [{release, {aesophia, "4.0.0-rc1"},
[aesophia, aebytecode, getopt]},
{dev_mode, true},
{include_erts, false},
{extended_start_script, true}]}.

View File

@ -1,30 +1,24 @@
{"1.2.0",
[{<<"gmbytecode">>,
{git,"https://git.qpq.swiss/QPQ-AG/gmbytecode.git",
{ref, "97cea33be8f3a35d26055664da7aa59531ff5537"}},
{"1.1.0",
[{<<"aebytecode">>,
{git,"https://github.com/aeternity/aebytecode.git",
{ref,"3f85375cb2288083e442541d5b53f9705f22053a"}},
0},
{<<"gmserialization">>,
{git,"https://git.qpq.swiss/QPQ-AG/gmserialization.git",
{ref,"ac64e01b0f675c1a34c70a827062f381920742db"}},
{<<"aeserialization">>,
{git,"https://github.com/aeternity/aeserialization.git",
{ref,"816bf994ffb5cee218c3f22dc5fea296c9e0882e"}},
1},
{<<"base58">>,
{git,"https://git.qpq.swiss/QPQ-AG/erl-base58.git",
{ref,"e6aa62eeae3d4388311401f06e4b939bf4e94b9c"}},
{git,"https://github.com/aeternity/erl-base58.git",
{ref,"60a335668a60328a29f9731b67c4a0e9e3d50ab6"}},
2},
{<<"eblake2">>,
{git,"https://git.qpq.swiss/QPQ-AG/eblake2.git",
{ref,"b29d585b8760746142014884007eb8441a3b6a14"}},
0},
{<<"enacl">>,
{git,"https://git.qpq.swiss/QPQ-AG/enacl.git",
{ref,"4eb7ec70084ba7c87b1af8797c4c4e90c84f95a2"}},
2},
{<<"getopt">>,
{git,"https://git.qpq.swiss/QPQ-AG/getopt.git",
{ref,"dbab6262a2430809430deda9d8650f58f9d80898"}},
1},
{<<"eblake2">>,{pkg,<<"eblake2">>,<<"1.0.0">>},0},
{<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0},
{<<"jsx">>,
{git,"https://github.com/talentdeficit/jsx.git",
{ref,"3074d4865b3385a050badf7828ad31490d860df5"}},
0}]}.
[
{pkg_hash,[
{<<"eblake2">>, <<"EC8AD20E438AAB3F2E8D5D118C366A0754219195F8A0F536587440F8F9BCF2EF">>},
{<<"getopt">>, <<"C73A9FA687B217F2FF79F68A3B637711BB1936E712B521D8CE466B29CBF7808A">>}]}
].

BIN
rebar3

Binary file not shown.

View File

@ -1,42 +1,35 @@
%%%-------------------------------------------------------------------
%%% @author Robert Virding
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2019, Aeternity Anstalt
%%% @doc
%%% ACI interface
%%% @end
%%% Created : 12 Jan 2019
%%%-------------------------------------------------------------------
-module(so_aci).
-vsn("9.0.0").
-module(aeso_aci).
-export([ file/2
, file/3
, contract_interface/2
, contract_interface/3
, from_typed_ast/2
, render_aci_json/1
, json_encode_expr/1
, json_encode_type/1]).
-include("so_utils.hrl").
-type aci_type() :: json | string.
-type json() :: jsx:json_term().
-type json_text() :: binary().
-export_type([aci_type/0]).
%% External API
-spec file(aci_type(), string()) -> {ok, json() | string()} | {error, term()}.
file(Type, File) ->
file(Type, File, []).
file(Type, File, Options0) ->
Options = so_compiler:add_include_path(File, Options0),
Options = aeso_compiler:add_include_path(File, Options0),
case file:read_file(File) of
{ok, BinCode} ->
do_contract_interface(Type, binary_to_list(BinCode), Options);
@ -57,11 +50,11 @@ contract_interface(Type, ContractString, CompilerOpts) ->
render_aci_json(Json) ->
do_render_aci_json(Json).
-spec json_encode_expr(so_syntax:expr()) -> json().
-spec json_encode_expr(aeso_syntax:expr()) -> json().
json_encode_expr(Expr) ->
encode_expr(Expr).
-spec json_encode_type(so_syntax:type()) -> json().
-spec json_encode_type(aeso_syntax:type()) -> json().
json_encode_type(Type) ->
encode_type(Type).
@ -70,21 +63,33 @@ do_contract_interface(Type, Contract, Options) when is_binary(Contract) ->
do_contract_interface(Type, binary_to_list(Contract), Options);
do_contract_interface(Type, ContractString, Options) ->
try
Ast = so_compiler:parse(ContractString, Options),
{TypedAst, _, _} = so_ast_infer_types:infer(Ast, [dont_unfold | Options]),
from_typed_ast(Type, TypedAst)
Ast = aeso_compiler:parse(ContractString, Options),
%% io:format("~p\n", [Ast]),
TypedAst = aeso_ast_infer_types:infer(Ast, [dont_unfold]),
%% io:format("~p\n", [TypedAst]),
JArray = [ encode_contract(C) || C <- TypedAst ],
case Type of
json -> {ok, JArray};
string -> do_render_aci_json(JArray)
end
catch
throw:{error, Errors} -> {error, Errors}
%% The compiler errors.
error:{parse_errors, Errors} ->
{error, join_errors("Parse errors", Errors, fun(E) -> E end)};
error:{type_errors, Errors} ->
{error, join_errors("Type errors", Errors, fun(E) -> E end)};
error:{code_errors, Errors} ->
{error, join_errors("Code errors", Errors,
fun (E) -> io_lib:format("~p", [E]) end)}
%% General programming errors in the compiler just signal error.
end.
from_typed_ast(Type, TypedAst) ->
JArray = [ encode_contract(C) || C <- TypedAst ],
case Type of
json -> {ok, JArray};
string -> do_render_aci_json(JArray)
end.
join_errors(Prefix, Errors, Pfun) ->
Ess = [ Pfun(E) || E <- Errors ],
list_to_binary(string:join([Prefix|Ess], "\n")).
encode_contract(Contract = {Head, _, {con, _, Name}, _, _}) when ?IS_CONTRACT_HEAD(Head) ->
encode_contract(Contract = {contract, _, {con, _, Name}, _}) ->
C0 = #{name => encode_name(Name)},
Tdefs0 = [ encode_typedef(T) || T <- sort_decls(contract_types(Contract)) ],
@ -92,7 +97,7 @@ encode_contract(Contract = {Head, _, {con, _, Name}, _, _}) when ?IS_CONTRACT_HE
{Es, Tdefs1} = lists:partition(FilterT(<<"event">>), Tdefs0),
{Ss, Tdefs} = lists:partition(FilterT(<<"state">>), Tdefs1),
C1 = C0#{typedefs => Tdefs},
C1 = C0#{type_defs => Tdefs},
C2 = case Es of
[] -> C1;
@ -108,11 +113,11 @@ encode_contract(Contract = {Head, _, {con, _, Name}, _, _}) when ?IS_CONTRACT_HE
|| F <- sort_decls(contract_funcs(Contract)),
is_entrypoint(F) ],
#{contract => C3#{kind => Head, functions => Fdefs, payable => is_payable(Contract)}};
#{contract => C3#{functions => Fdefs, payable => is_payable(Contract)}};
encode_contract(Namespace = {namespace, _, {con, _, Name}, _}) ->
Tdefs = [ encode_typedef(T) || T <- sort_decls(contract_types(Namespace)) ],
#{namespace => #{name => encode_name(Name),
typedefs => Tdefs}}.
type_defs => Tdefs}}.
%% Encode a function definition. Currently we are only interested in
%% the interface and type.
@ -136,7 +141,7 @@ encode_anon_args(Types) ->
encode_args(Args) -> [ encode_arg(A) || A <- Args ].
encode_arg({typed, _, Id, T}) ->
encode_arg({arg, _, Id, T}) ->
#{name => encode_type(Id),
type => encode_type(T)}.
@ -199,11 +204,8 @@ encode_expr({bytes, _, B}) ->
<<N:Digits/unit:8>> = B,
list_to_binary(lists:flatten(io_lib:format("#~*.16.0b", [Digits*2, N])));
encode_expr({Lit, _, L}) when Lit == oracle_pubkey; Lit == oracle_query_id;
Lit == contract_pubkey; Lit == account_pubkey;
Lit == signature ->
gmser_api_encoder:encode(Lit, L);
encode_expr({app, _, {'-', _}, [{int, _, N}]}) ->
encode_expr({int, [], -N});
Lit == contract_pubkey; Lit == account_pubkey ->
aeser_api_encoder:encode(Lit, L);
encode_expr({app, _, F, As}) ->
Ef = encode_expr(F),
Eas = encode_exprs(As),
@ -234,21 +236,15 @@ do_render_aci_json(Json) ->
{ok, list_to_binary(string:join(DecodedContracts, "\n"))}.
decode_contract(#{contract := #{name := Name,
kind := Kind,
payable := Payable,
typedefs := Ts0,
type_defs := Ts0,
functions := Fs} = C}) ->
MkTDef = fun(N, T) -> #{name => N, vars => [], typedef => T} end,
Ts = [ MkTDef(<<"state">>, maps:get(state, C)) || maps:is_key(state, C) ] ++
[ MkTDef(<<"event">>, maps:get(event, C)) || maps:is_key(event, C) ] ++ Ts0,
[payable(Payable), case Kind of
contract_main -> "main contract ";
contract_child -> "contract ";
contract_interface -> "contract interface "
end,
io_lib:format("~s", [Name])," =\n",
[payable(Payable), "contract ", io_lib:format("~s", [Name])," =\n",
decode_tdefs(Ts), decode_funcs(Fs)];
decode_contract(#{namespace := #{name := Name, typedefs := Ts}}) when Ts /= [] ->
decode_contract(#{namespace := #{name := Name, type_defs := Ts}}) when Ts /= [] ->
["namespace ", io_lib:format("~s", [Name])," =\n",
decode_tdefs(Ts)];
decode_contract(_) -> [].
@ -256,8 +252,8 @@ decode_contract(_) -> [].
decode_funcs(Fs) -> [ decode_func(F) || F <- Fs ].
%% decode_func(#{name := init}) -> [];
decode_func(#{name := Name, stateful:= Stateful, payable := Payable, arguments := As, returns := T}) ->
[" ", payable(Payable), stateful(Stateful), "entrypoint ", io_lib:format("~s", [Name]), " : ",
decode_func(#{name := Name, payable := Payable, arguments := As, returns := T}) ->
[" ", payable(Payable), "entrypoint ", io_lib:format("~s", [Name]), " : ",
decode_args(As), " => ", decode_type(T), $\n].
decode_args(As) ->
@ -284,8 +280,6 @@ decode_type(#{list := [Et]}) ->
decode_type(#{map := Ets}) ->
Ts = decode_types(Ets),
["map",$(,lists:join(",", Ts),$)];
decode_type(#{bytes := any}) ->
["bytes()"];
decode_type(#{bytes := Len}) ->
["bytes(", integer_to_list(Len), ")"];
decode_type(#{variant := Ets}) ->
@ -340,17 +334,12 @@ decode_tvar(#{name := N}) -> io_lib:format("~s", [N]).
payable(true) -> "payable ";
payable(false) -> "".
stateful(true) -> "stateful ";
stateful(false) -> "".
%% #contract{Ann, Con, [Declarations]}.
contract_funcs({C, _, _, _, Decls}) when ?IS_CONTRACT_HEAD(C) ->
contract_funcs({C, _, _, Decls}) when C == contract; C == namespace ->
[ D || D <- Decls, is_fun(D)].
contract_types({namespace, _, _, Decls}) ->
[ D || D <- Decls, is_type(D) ];
contract_types({C, _, _, _, Decls}) when ?IS_CONTRACT_HEAD(C) ->
contract_types({C, _, _, Decls}) when C == contract; C == namespace ->
[ D || D <- Decls, is_type(D) ].
is_fun({letfun, _, _, _, _, _}) -> true;
@ -362,14 +351,14 @@ is_type(_) -> false.
sort_decls(Ds) ->
Sort = fun (D1, D2) ->
so_syntax:get_ann(line, D1, 0) =<
so_syntax:get_ann(line, D2, 0)
aeso_syntax:get_ann(line, D1, 0) =<
aeso_syntax:get_ann(line, D2, 0)
end,
lists:sort(Sort, Ds).
is_entrypoint(Node) -> so_syntax:get_ann(entrypoint, Node, false).
is_stateful(Node) -> so_syntax:get_ann(stateful, Node, false).
is_payable(Node) -> so_syntax:get_ann(payable, Node, false).
is_entrypoint(Node) -> aeso_syntax:get_ann(entrypoint, Node, false).
is_stateful(Node) -> aeso_syntax:get_ann(stateful, Node, false).
is_payable(Node) -> aeso_syntax:get_ann(payable, Node, false).
typedef_name({type_def, _, {id, _, Name}, _, _}) -> Name.

View File

@ -1,5 +1,4 @@
-module(so_ast).
-vsn("9.0.0").
-module(aeso_ast).
-export([int/2,
line/1,
@ -18,11 +17,11 @@ line({symbol, Line, _}) -> Line.
symbol_name({symbol, _, Name}) -> Name.
pp(Ast) ->
String = prettypr:format(so_pretty:decls(Ast, [])),
String = prettypr:format(aeso_pretty:decls(Ast, [])),
io:format("Ast:\n~s\n", [String]).
pp_typed(TypedAst) ->
%% io:format("Typed tree:\n~p\n",[TypedAst]),
String = prettypr:format(so_pretty:decls(TypedAst, [show_generated])),
String = prettypr:format(aeso_pretty:decls(TypedAst, [show_generated])),
io:format("Type ast:\n~s\n",[String]).

2495
src/aeso_ast_infer_types.erl Normal file

File diff suppressed because it is too large Load Diff

1557
src/aeso_ast_to_fcode.erl Normal file

File diff suppressed because it is too large Load Diff

923
src/aeso_ast_to_icode.erl Normal file
View File

@ -0,0 +1,923 @@
%%%-------------------------------------------------------------------
%%% @author Happi (Erik Stenman)
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc
%%% Compiler from Aeterinty Sophia language to the Aeternity VM, aevm.
%%% @end
%%% Created : 21 Dec 2017
%%%
%%%-------------------------------------------------------------------
-module(aeso_ast_to_icode).
-export([ast_typerep/1, ast_typerep/2, type_value/1,
convert_typed/2, prim_call/5]).
-include_lib("aebytecode/include/aeb_opcodes.hrl").
-include("aeso_icode.hrl").
-spec convert_typed(aeso_syntax:ast(), list()) -> aeso_icode:icode().
convert_typed(TypedTree, Options) ->
{Payable, Name} =
case lists:last(TypedTree) of
{contract, Attrs, {con, _, Con}, _} ->
{proplists:get_value(payable, Attrs, false), Con};
_ ->
gen_error(last_declaration_must_be_contract)
end,
NewIcode = aeso_icode:set_payable(Payable,
aeso_icode:set_name(Name, aeso_icode:new(Options))),
Icode = code(TypedTree, NewIcode, Options),
deadcode_elimination(Icode).
code([{contract, _Attribs, Con, Code}|Rest], Icode, Options) ->
NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Con, Icode)),
code(Rest, NewIcode, Options);
code([{namespace, _Ann, Name, Code}|Rest], Icode, Options) ->
%% TODO: nested namespaces
NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Name, Icode)),
code(Rest, NewIcode, Options);
code([], Icode, Options) ->
add_default_init_function(add_builtins(Icode), Options).
%% Generate error on correct format.
gen_error(Error) ->
error({code_errors, [Error]}).
%% Create default init function (only if state is unit).
add_default_init_function(Icode = #{functions := Funs, state_type := State}, Options) ->
NoCode = proplists:get_value(no_code, Options, false),
{_, _, QInit} = aeso_icode:qualify({id, [], "init"}, Icode),
case lists:keymember(QInit, 1, Funs) of
true -> Icode;
false when NoCode -> Icode;
false when State /= {tuple, []} ->
gen_error(missing_init_function);
false ->
Type = {tuple, [typerep, {tuple, []}]},
Value = #tuple{ cpts = [type_value({tuple, []}), {tuple, []}] },
DefaultInit = {QInit, [], [], Value, Type},
Icode#{ functions => [DefaultInit | Funs] }
end.
-spec contract_to_icode(aeso_syntax:ast(), aeso_icode:icode()) ->
aeso_icode:icode().
contract_to_icode([{namespace, _, Name, Defs} | Rest], Icode) ->
NS = aeso_icode:get_namespace(Icode),
Icode1 = contract_to_icode(Defs, aeso_icode:enter_namespace(Name, Icode)),
contract_to_icode(Rest, aeso_icode:set_namespace(NS, Icode1));
contract_to_icode([{type_def, _Attrib, Id = {id, _, Name}, Args, Def} | Rest],
Icode = #{ types := Types, constructors := Constructors }) ->
TypeDef = make_type_def(Args, Def, Icode),
NewConstructors =
case Def of
{variant_t, Cons} ->
Tags = lists:seq(0, length(Cons) - 1),
GetName = fun({constr_t, _, C, _}) -> C end,
QName = fun(Con) -> {_, _, Xs} = aeso_icode:qualify(GetName(Con), Icode), Xs end,
maps:from_list([ {QName(Con), Tag} || {Tag, Con} <- lists:zip(Tags, Cons) ]);
_ -> #{}
end,
{_, _, TName} = aeso_icode:qualify(Id, Icode),
Icode1 = Icode#{ types := Types#{ TName => TypeDef },
constructors := maps:merge(Constructors, NewConstructors) },
Icode2 = case Name of
"state" when Args == [] -> Icode1#{ state_type => ast_typerep(Def, Icode) };
"state" -> gen_error(state_type_cannot_be_parameterized);
"event" when Args == [] -> Icode1#{ event_type => Def };
"event" -> gen_error(event_type_cannot_be_parameterized);
_ -> Icode1
end,
contract_to_icode(Rest, Icode2);
contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest], Icode) ->
FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++
[ payable || proplists:get_value(payable, Attrib, false) ] ++
[ private || is_private(Attrib, Icode) ],
%% TODO: Handle types
FunName = ast_id(Name),
%% TODO: push funname to env
FunArgs = ast_args(Args, [], Icode),
%% TODO: push args to env
{FunBody, TypeRep} =
case FunName of
"init" ->
%% Pair the initial state with a typerep for the state (TODO: until we have the state type in some contract metadata)
#{ state_type := StateType } = Icode,
{#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] },
{tuple, [typerep, ast_typerep(T, Icode)]}};
_ -> {ast_body(Body, Icode), ast_typerep(T, Icode)}
end,
QName = aeso_icode:qualify(Name, Icode),
NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode),
contract_to_icode(Rest, NewIcode);
contract_to_icode([], Icode) -> Icode;
contract_to_icode([{fun_decl, _, _, _} | Code], Icode) ->
contract_to_icode(Code, Icode);
contract_to_icode([Decl | Code], Icode) ->
io:format("Unhandled declaration: ~p\n", [Decl]),
contract_to_icode(Code, Icode).
ast_id({id, _, Id}) -> Id;
ast_id({qid, _, Id}) -> Id.
ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) ->
ast_args(Rest, [{ast_id(Name), ast_type(Type, Icode)}| Acc], Icode);
ast_args([], Acc, _Icode) -> lists:reverse(Acc).
ast_type(T, Icode) ->
ast_typerep(T, Icode).
-define(id_app(Fun, Args, ArgTypes, OutType),
{app, _, {typed, _, {id, _, Fun}, {fun_t, _, _, ArgTypes, OutType}}, Args}).
-define(qid_app(Fun, Args, ArgTypes, OutType),
{app, _, {typed, _, {qid, _, Fun}, {fun_t, _, _, ArgTypes, OutType}}, Args}).
-define(oracle_t(Q, R), {app_t, _, {id, _, "oracle"}, [Q, R]}).
-define(query_t(Q, R), {app_t, _, {id, _, "oracle_query"}, [Q, R]}).
-define(option_t(A), {app_t, _, {id, _, "option"}, [A]}).
-define(map_t(K, V), {app_t, _, {id, _, "map"}, [K, V]}).
ast_body(?qid_app(["Chain","spend"], [To, Amount], _, _), Icode) ->
prim_call(?PRIM_CALL_SPEND, ast_body(Amount, Icode), [ast_body(To, Icode)], [word], {tuple, []});
ast_body(?qid_app([Con, "Chain", "event"], [Event], _, _), Icode = #{ contract_name := Con }) ->
aeso_builtins:check_event_type(Icode),
builtin_call({event, maps:get(event_type, Icode)}, [ast_body(Event, Icode)]);
%% Chain environment
ast_body(?qid_app(["Chain", "balance"], [Address], _, _), Icode) ->
#prim_balance{ address = ast_body(Address, Icode) };
ast_body(?qid_app(["Chain", "block_hash"], [Height], _, _), Icode) ->
builtin_call(block_hash, [ast_body(Height, Icode)]);
ast_body(?qid_app(["Call", "gas_left"], [], _, _), _Icode) ->
prim_gas_left;
ast_body({qid, _, ["Contract", "address"]}, _Icode) -> prim_contract_address;
ast_body({qid, _, ["Contract", "creator"]}, _Icode) -> prim_contract_creator;
ast_body({qid, _, ["Contract", "balance"]}, _Icode) -> #prim_balance{ address = prim_contract_address };
ast_body({qid, _, ["Call", "origin"]}, _Icode) -> prim_call_origin;
ast_body({qid, _, ["Call", "caller"]}, _Icode) -> prim_caller;
ast_body({qid, _, ["Call", "value"]}, _Icode) -> prim_call_value;
ast_body({qid, _, ["Call", "gas_price"]}, _Icode) -> prim_gas_price;
ast_body({qid, _, ["Chain", "coinbase"]}, _Icode) -> prim_coinbase;
ast_body({qid, _, ["Chain", "timestamp"]}, _Icode) -> prim_timestamp;
ast_body({qid, _, ["Chain", "block_height"]}, _Icode) -> prim_block_height;
ast_body({qid, _, ["Chain", "difficulty"]}, _Icode) -> prim_difficulty;
ast_body({qid, _, ["Chain", "gas_limit"]}, _Icode) -> prim_gas_limit;
%% TODO: eta expand!
ast_body({qid, _, ["Chain", "balance"]}, _Icode) ->
gen_error({underapplied_primitive, 'Chain.balance'});
ast_body({qid, _, ["Chain", "block_hash"]}, _Icode) ->
gen_error({underapplied_primitive, 'Chain.block_hash'});
ast_body({qid, _, ["Chain", "spend"]}, _Icode) ->
gen_error({underapplied_primitive, 'Chain.spend'});
%% State
ast_body({qid, _, [Con, "state"]}, #{ contract_name := Con }) -> prim_state;
ast_body(?qid_app([Con, "put"], [NewState], _, _), Icode = #{ contract_name := Con }) ->
#prim_put{ state = ast_body(NewState, Icode) };
ast_body({qid, _, [Con, "put"]}, #{ contract_name := Con }) ->
gen_error({underapplied_primitive, put}); %% TODO: eta
%% Abort
ast_body(?id_app("abort", [String], _, _), Icode) ->
builtin_call(abort, [ast_body(String, Icode)]);
ast_body(?id_app("require", [Bool, String], _, _), Icode) ->
builtin_call(require, [ast_body(Bool, Icode), ast_body(String, Icode)]);
%% Authentication
ast_body({qid, _, ["Auth", "tx_hash"]}, _Icode) ->
prim_call(?PRIM_CALL_AUTH_TX_HASH, #integer{value = 0},
[], [], aeso_icode:option_typerep(word));
%% Oracles
ast_body(?qid_app(["Oracle", "register"], Args, _, ?oracle_t(QType, RType)), Icode) ->
{Sign, [Acct, QFee, TTL]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_ORACLE_REGISTER, #integer{value = 0},
[ast_body(Acct, Icode), ast_body(Sign, Icode), ast_body(QFee, Icode), ast_body(TTL, Icode),
ast_type_value(QType, Icode), ast_type_value(RType, Icode)],
[word, sign_t(), word, ttl_t(Icode), typerep, typerep], word);
ast_body(?qid_app(["Oracle", "query_fee"], [Oracle], _, _), Icode) ->
prim_call(?PRIM_CALL_ORACLE_QUERY_FEE, #integer{value = 0},
[ast_body(Oracle, Icode)], [word], word);
ast_body(?qid_app(["Oracle", "query"], [Oracle, Q, QFee, QTTL, RTTL], [_, QType, _, _, _], _), Icode) ->
prim_call(?PRIM_CALL_ORACLE_QUERY, ast_body(QFee, Icode),
[ast_body(Oracle, Icode), ast_body(Q, Icode), ast_body(QTTL, Icode), ast_body(RTTL, Icode)],
[word, ast_type(QType, Icode), ttl_t(Icode), ttl_t(Icode)], word);
ast_body(?qid_app(["Oracle", "extend"], Args, _, _), Icode) ->
{Sign, [Oracle, TTL]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_ORACLE_EXTEND, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Sign, Icode), ast_body(TTL, Icode)],
[word, sign_t(), ttl_t(Icode)], {tuple, []});
ast_body(?qid_app(["Oracle", "respond"], Args, [_, _, RType], _), Icode) ->
{Sign, [Oracle, Query, R]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_ORACLE_RESPOND, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Query, Icode), ast_body(Sign, Icode), ast_body(R, Icode)],
[word, word, sign_t(), ast_type(RType, Icode)], {tuple, []});
ast_body(?qid_app(["Oracle", "get_question"], [Oracle, Q], [_, ?query_t(QType, _)], _), Icode) ->
prim_call(?PRIM_CALL_ORACLE_GET_QUESTION, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], ast_type(QType, Icode));
ast_body(?qid_app(["Oracle", "get_answer"], [Oracle, Q], [_, ?query_t(_, RType)], _), Icode) ->
prim_call(?PRIM_CALL_ORACLE_GET_ANSWER, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], aeso_icode:option_typerep(ast_type(RType, Icode)));
ast_body(?qid_app(["Oracle", "check"], [Oracle], [?oracle_t(Q, R)], _), Icode) ->
prim_call(?PRIM_CALL_ORACLE_CHECK, #integer{value = 0},
[ast_body(Oracle, Icode), ast_type_value(Q, Icode), ast_type_value(R, Icode)],
[word, typerep, typerep], word);
ast_body(?qid_app(["Oracle", "check_query"], [Oracle, Query], [_, ?query_t(Q, R)], _), Icode) ->
prim_call(?PRIM_CALL_ORACLE_CHECK_QUERY, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Query, Icode),
ast_type_value(Q, Icode), ast_type_value(R, Icode)],
[word, typerep, typerep], word);
ast_body({qid, _, ["Oracle", "register"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.register'});
ast_body({qid, _, ["Oracle", "query"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.query'});
ast_body({qid, _, ["Oracle", "extend"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.extend'});
ast_body({qid, _, ["Oracle", "respond"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.respond'});
ast_body({qid, _, ["Oracle", "query_fee"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.query_fee'});
ast_body({qid, _, ["Oracle", "get_answer"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.get_answer'});
ast_body({qid, _, ["Oracle", "get_question"]}, _Icode) -> gen_error({underapplied_primitive, 'Oracle.get_question'});
%% Name service
ast_body(?qid_app(["AENS", "resolve"], [Name, Key], _, ?option_t(Type)), Icode) ->
case is_monomorphic(Type) of
true ->
case ast_type(Type, Icode) of
T when T == word; T == string -> ok;
_ -> gen_error({invalid_result_type, 'AENS.resolve', Type})
end,
prim_call(?PRIM_CALL_AENS_RESOLVE, #integer{value = 0},
[ast_body(Name, Icode), ast_body(Key, Icode), ast_type_value(Type, Icode)],
[string, string, typerep], aeso_icode:option_typerep(ast_type(Type, Icode)));
false ->
gen_error({unresolved_result_type, 'AENS.resolve', Type})
end;
ast_body(?qid_app(["AENS", "preclaim"], Args, _, _), Icode) ->
{Sign, [Addr, CHash]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_AENS_PRECLAIM, #integer{value = 0},
[ast_body(Addr, Icode), ast_body(CHash, Icode), ast_body(Sign, Icode)],
[word, word, sign_t()], {tuple, []});
ast_body(?qid_app(["AENS", "claim"], Args, _, _), Icode) ->
{Sign, [Addr, Name, Salt]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_AENS_CLAIM, #integer{value = 0},
[ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Salt, Icode), ast_body(Sign, Icode)],
[word, string, word, sign_t()], {tuple, []});
ast_body(?qid_app(["AENS", "transfer"], Args, _, _), Icode) ->
{Sign, [FromAddr, ToAddr, Name]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_AENS_TRANSFER, #integer{value = 0},
[ast_body(FromAddr, Icode), ast_body(ToAddr, Icode), ast_body(Name, Icode), ast_body(Sign, Icode)],
[word, word, word, sign_t()], {tuple, []});
ast_body(?qid_app(["AENS", "revoke"], Args, _, _), Icode) ->
{Sign, [Addr, Name]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_AENS_REVOKE, #integer{value = 0},
[ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Sign, Icode)],
[word, word, sign_t()], {tuple, []});
ast_body(?qid_app(["AENS", "subname"], Args, _, _), Icode) ->
{Sign, [Addr, Name, Subnames]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_AENS_SUBNAME, #integer{value = 0},
[ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Subnames, Icode), ast_body(Sign, Icode)],
[word, word, word, sign_t()], {tuple, []});
ast_body({qid, _, ["AENS", "resolve"]}, _Icode) -> gen_error({underapplied_primitive, 'AENS.resolve'});
ast_body({qid, _, ["AENS", "preclaim"]}, _Icode) -> gen_error({underapplied_primitive, 'AENS.preclaim'});
ast_body({qid, _, ["AENS", "claim"]}, _Icode) -> gen_error({underapplied_primitive, 'AENS.claim'});
ast_body({qid, _, ["AENS", "transfer"]}, _Icode) -> gen_error({underapplied_primitive, 'AENS.transfer'});
ast_body({qid, _, ["AENS", "revoke"]}, _Icode) -> gen_error({underapplied_primitive, 'AENS.revoke'});
ast_body({qid, _, ["AENS", "subname"]}, _Icode) -> gen_error({underapplied_primitive, 'AENS.subname'});
%% Maps
%% -- map lookup m[k]
ast_body({map_get, _, Map, Key}, Icode) ->
{_, ValType} = check_monomorphic_map(Map, Icode),
Fun = {map_get, ast_typerep(ValType, Icode)},
builtin_call(Fun, [ast_body(Map, Icode), ast_body(Key, Icode)]);
%% -- map lookup_default m[k = v]
ast_body({map_get, _, Map, Key, Val}, Icode) ->
{_, ValType} = check_monomorphic_map(Map, Icode),
Fun = {map_lookup_default, ast_typerep(ValType, Icode)},
builtin_call(Fun, [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Val, Icode)]);
%% -- lookup functions
ast_body(?qid_app(["Map", "lookup"], [Key, Map], _, _), Icode) ->
map_get(Key, Map, Icode);
ast_body(?qid_app(["Map", "lookup_default"], [Key, Map, Val], _, _), Icode) ->
{_, ValType} = check_monomorphic_map(Map, Icode),
Fun = {map_lookup_default, ast_typerep(ValType, Icode)},
builtin_call(Fun, [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Val, Icode)]);
ast_body(?qid_app(["Map", "member"], [Key, Map], _, _), Icode) ->
builtin_call(map_member, [ast_body(Map, Icode), ast_body(Key, Icode)]);
ast_body(?qid_app(["Map", "size"], [Map], _, _), Icode) ->
builtin_call(map_size, [ast_body(Map, Icode)]);
ast_body(?qid_app(["Map", "delete"], [Key, Map], _, _), Icode) ->
map_del(Key, Map, Icode);
%% -- map conversion to/from list
ast_body(App = ?qid_app(["Map", "from_list"], [List], _, MapType), Icode) ->
Ann = aeso_syntax:get_ann(App),
{KeyType, ValType} = check_monomorphic_map(Ann, MapType, Icode),
builtin_call(map_from_list, [ast_body(List, Icode), map_empty(KeyType, ValType, Icode)]);
ast_body(?qid_app(["Map", "to_list"], [Map], _, _), Icode) ->
map_tolist(Map, Icode);
ast_body({qid, _, ["Map", "from_list"]}, _Icode) -> gen_error({underapplied_primitive, 'Map.from_list'});
%% ast_body({qid, _, ["Map", "to_list"]}, _Icode) -> gen_error({underapplied_primitive, 'Map.to_list'});
ast_body({qid, _, ["Map", "lookup"]}, _Icode) -> gen_error({underapplied_primitive, 'Map.lookup'});
ast_body({qid, _, ["Map", "lookup_default"]}, _Icode) -> gen_error({underapplied_primitive, 'Map.lookup_default'});
ast_body({qid, _, ["Map", "member"]}, _Icode) -> gen_error({underapplied_primitive, 'Map.member'});
%% -- map construction { k1 = v1, k2 = v2 }
ast_body({typed, Ann, {map, _, KVs}, MapType}, Icode) ->
{KeyType, ValType} = check_monomorphic_map(Ann, MapType, Icode),
lists:foldr(fun({K, V}, Map) ->
builtin_call(map_put, [Map, ast_body(K, Icode), ast_body(V, Icode)])
end, map_empty(KeyType, ValType, Icode), KVs);
%% -- map update m { [k] = v } or m { [k] @ x = f(x) } or m { [k = v] @ x = f(x) }
ast_body({map, _, Map, []}, Icode) -> ast_body(Map, Icode);
ast_body({map, _, Map, [Upd]}, Icode) ->
case Upd of
{field, _, [{map_get, _, Key}], Val} ->
map_put(Key, Val, Map, Icode);
{field_upd, _, [{map_get, _, Key}], ValFun} ->
map_upd(Key, ValFun, Map, Icode);
{field_upd, _, [{map_get, _, Key, Val}], ValFun} ->
map_upd(Key, Val, ValFun, Map, Icode)
end;
ast_body({map, Ann, Map, [Upd | Upds]}, Icode) ->
ast_body({map, Ann, {map, Ann, Map, [Upd]}, Upds}, Icode);
%% Crypto
ast_body(?qid_app(["Crypto", "verify_sig"], [Msg, PK, Sig], _, _), Icode) ->
prim_call(?PRIM_CALL_CRYPTO_VERIFY_SIG, #integer{value = 0},
[ast_body(Msg, Icode), ast_body(PK, Icode), ast_body(Sig, Icode)],
[word, word, sign_t()], word);
ast_body(?qid_app(["Crypto", "verify_sig_secp256k1"], [Msg, PK, Sig], _, _), Icode) ->
prim_call(?PRIM_CALL_CRYPTO_VERIFY_SIG_SECP256K1, #integer{value = 0},
[ast_body(Msg, Icode), ast_body(PK, Icode), ast_body(Sig, Icode)],
[bytes_t(32), bytes_t(64), bytes_t(64)], word);
ast_body(?qid_app(["Crypto", "ecverify_secp256k1"], [Msg, Addr, Sig], _, _), Icode) ->
prim_call(?PRIM_CALL_CRYPTO_ECVERIFY_SECP256K1, #integer{value = 0},
[ast_body(Msg, Icode), ast_body(Addr, Icode), ast_body(Sig, Icode)],
[word, bytes_t(20), bytes_t(65)], word);
ast_body(?qid_app(["Crypto", "ecrecover_secp256k1"], [Msg, Sig], _, _), Icode) ->
prim_call(?PRIM_CALL_CRYPTO_ECRECOVER_SECP256K1, #integer{value = 0},
[ast_body(Msg, Icode), ast_body(Sig, Icode)],
[word, bytes_t(65)], aeso_icode:option_typerep(bytes_t(20)));
ast_body(?qid_app(["Crypto", "sha3"], [Term], [Type], _), Icode) ->
generic_hash_primop(?PRIM_CALL_CRYPTO_SHA3, Term, Type, Icode);
ast_body(?qid_app(["Crypto", "sha256"], [Term], [Type], _), Icode) ->
generic_hash_primop(?PRIM_CALL_CRYPTO_SHA256, Term, Type, Icode);
ast_body(?qid_app(["Crypto", "blake2b"], [Term], [Type], _), Icode) ->
generic_hash_primop(?PRIM_CALL_CRYPTO_BLAKE2B, Term, Type, Icode);
ast_body(?qid_app(["String", "sha256"], [String], _, _), Icode) ->
string_hash_primop(?PRIM_CALL_CRYPTO_SHA256_STRING, String, Icode);
ast_body(?qid_app(["String", "blake2b"], [String], _, _), Icode) ->
string_hash_primop(?PRIM_CALL_CRYPTO_BLAKE2B_STRING, String, Icode);
%% Strings
%% -- String length
ast_body(?qid_app(["String", "length"], [String], _, _), Icode) ->
builtin_call(string_length, [ast_body(String, Icode)]);
%% -- String concat
ast_body(?qid_app(["String", "concat"], [String1, String2], _, _), Icode) ->
builtin_call(string_concat, [ast_body(String1, Icode), ast_body(String2, Icode)]);
%% -- String hash (sha3)
ast_body(?qid_app(["String", "sha3"], [String], _, _), Icode) ->
#unop{ op = 'sha3', rand = ast_body(String, Icode) };
%% -- Bits
ast_body(?qid_app(["Bits", Fun], Args, _, _), Icode)
when Fun == "test"; Fun == "set"; Fun == "clear";
Fun == "union"; Fun == "intersection"; Fun == "difference" ->
C = fun(N) when is_integer(N) -> #integer{ value = N };
(X) -> X end,
Bin = fun(O) -> fun(A, B) -> #binop{ op = O, left = C(A), right = C(B) } end end,
And = Bin('band'),
Or = Bin('bor'),
Bsl = fun(A, B) -> (Bin('bsl'))(B, A) end, %% flipped arguments
Bsr = fun(A, B) -> (Bin('bsr'))(B, A) end,
Neg = fun(A) -> #unop{ op = 'bnot', rand = C(A) } end,
case [Fun | [ ast_body(Arg, Icode) || Arg <- Args ]] of
["test", Bits, Ix] -> And(Bsr(Bits, Ix), 1);
["set", Bits, Ix] -> Or(Bits, Bsl(1, Ix));
["clear", Bits, Ix] -> And(Bits, Neg(Bsl(1, Ix)));
["union", A, B] -> Or(A, B);
["intersection", A, B] -> And(A, B);
["difference", A, B] -> And(A, Neg(And(A, B)))
end;
ast_body({qid, _, ["Bits", "none"]}, _Icode) ->
#integer{ value = 0 };
ast_body({qid, _, ["Bits", "all"]}, _Icode) ->
#integer{ value = 1 bsl 256 - 1 };
ast_body(?qid_app(["Bits", "sum"], [Bits], _, _), Icode) ->
builtin_call(popcount, [ast_body(Bits, Icode), #integer{ value = 0 }]);
%% -- Conversion
ast_body(?qid_app(["Int", "to_str"], [Int], _, _), Icode) ->
builtin_call(int_to_str, [ast_body(Int, Icode)]);
ast_body(?qid_app(["Address", "to_str"], [Addr], _, _), Icode) ->
builtin_call(addr_to_str, [ast_body(Addr, Icode)]);
ast_body(?qid_app(["Address", "is_oracle"], [Addr], _, _), Icode) ->
prim_call(?PRIM_CALL_ADDR_IS_ORACLE, #integer{value = 0},
[ast_body(Addr, Icode)], [word], word);
ast_body(?qid_app(["Address", "is_contract"], [Addr], _, _), Icode) ->
prim_call(?PRIM_CALL_ADDR_IS_CONTRACT, #integer{value = 0},
[ast_body(Addr, Icode)], [word], word);
ast_body(?qid_app(["Address", "is_payable"], [Addr], _, _), Icode) ->
prim_call(?PRIM_CALL_ADDR_IS_PAYABLE, #integer{value = 0},
[ast_body(Addr, Icode)], [word], word);
ast_body(?qid_app(["Bytes", "to_int"], [Bytes], _, _), Icode) ->
{typed, _, _, {bytes_t, _, N}} = Bytes,
builtin_call({bytes_to_int, N}, [ast_body(Bytes, Icode)]);
ast_body(?qid_app(["Bytes", "to_str"], [Bytes], _, _), Icode) ->
{typed, _, _, {bytes_t, _, N}} = Bytes,
builtin_call({bytes_to_str, N}, [ast_body(Bytes, Icode)]);
%% Other terms
ast_body({id, _, Name}, _Icode) ->
#var_ref{name = Name};
ast_body({qid, _, Name}, _Icode) ->
#var_ref{name = Name};
ast_body({bool, _, Bool}, _Icode) -> %BOOL as ints
Value = if Bool -> 1 ; true -> 0 end,
#integer{value = Value};
ast_body({int, _, Value}, _Icode) ->
#integer{value = Value};
ast_body({bytes, _, Bin}, _Icode) ->
case aeb_memory:binary_to_words(Bin) of
[Word] -> #integer{value = Word};
Words -> #tuple{cpts = [#integer{value = W} || W <- Words]}
end;
ast_body({Key, _, Bin}, _Icode) when Key == account_pubkey;
Key == contract_pubkey;
Key == oracle_pubkey;
Key == oracle_query_id ->
<<Value:32/unit:8>> = Bin,
#integer{value = Value};
ast_body({string,_,Bin}, _Icode) ->
Cpts = [size(Bin) | aeb_memory:binary_to_words(Bin)],
#tuple{cpts = [#integer{value=X} || X <- Cpts]};
ast_body({tuple,_,Args}, Icode) ->
#tuple{cpts = [ast_body(A, Icode) || A <- Args]};
ast_body({list,_,Args}, Icode) ->
#list{elems = [ast_body(A, Icode) || A <- Args]};
%% Typed contract calls
ast_body({proj, _, {typed, _, Addr, {con, _, _}}, {id, _, "address"}}, Icode) ->
ast_body(Addr, Icode); %% Values of contract types _are_ addresses.
ast_body({app, _, {typed, _, {proj, _, {typed, _, Addr, {con, _, Contract}}, {id, _, FunName}},
{fun_t, _, NamedT, ArgsT, OutT}}, Args0}, Icode) ->
NamedArgs = [Arg || Arg = {named_arg, _, _, _} <- Args0],
Args = Args0 -- NamedArgs,
ArgOpts = [ {Name, ast_body(Value, Icode)} || {named_arg, _, {id, _, Name}, Value} <- NamedArgs ],
Defaults = [ {Name, ast_body(Default, Icode)} || {named_arg_t, _, {id, _, Name}, _, Default} <- NamedT ],
%% TODO: eta expand
length(Args) /= length(ArgsT) andalso
gen_error({underapplied_contract_call,
string:join([Contract, FunName], ".")}),
ArgsI = [ ast_body(Arg, Icode) || Arg <- Args ],
ArgType = ast_typerep({tuple_t, [], ArgsT}),
Gas = proplists:get_value("gas", ArgOpts ++ Defaults),
Value = proplists:get_value("value", ArgOpts ++ Defaults),
OutType = ast_typerep(OutT, Icode),
<<TypeHash:256>> = aeb_aevm_abi:function_type_hash(list_to_binary(FunName), ArgType, OutType),
%% The function is represented by its type hash (which includes the name)
Fun = #integer{value = TypeHash},
#prim_call_contract{
address = ast_body(Addr, Icode),
gas = Gas,
value = Value,
arg = #tuple{cpts = [Fun, #tuple{ cpts = ArgsI }]},
%% The type check is implicitly done by using the type hash as the
%% entrypoint on the callee side.
type_hash= #integer{value = 0}
};
ast_body({proj, _, {typed, _, _, {con, _, Contract}}, {id, _, FunName}}, _Icode) ->
gen_error({underapplied_contract_call,
string:join([Contract, FunName], ".")});
ast_body({con, _, Name}, Icode) ->
Tag = aeso_icode:get_constructor_tag([Name], Icode),
#tuple{cpts = [#integer{value = Tag}]};
ast_body({qcon, _, Name}, Icode) ->
Tag = aeso_icode:get_constructor_tag(Name, Icode),
#tuple{cpts = [#integer{value = Tag}]};
ast_body({app, _, {typed, _, {con, _, Name}, _}, Args}, Icode) ->
Tag = aeso_icode:get_constructor_tag([Name], Icode),
#tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]};
ast_body({app, _, {typed, _, {qcon, _, Name}, _}, Args}, Icode) ->
Tag = aeso_icode:get_constructor_tag(Name, Icode),
#tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]};
ast_body({app, _, {'..', _}, [A, B]}, Icode) ->
#funcall
{ function = #var_ref{ name = ["ListInternal", "from_to"] }
, args = [ast_body(A, Icode), ast_body(B, Icode)] };
ast_body({app,As,Fun,Args}, Icode) ->
case aeso_syntax:get_ann(format, As) of
infix ->
{Op, _} = Fun,
[A, B] = Args,
ast_binop(Op, As, A, B, Icode);
prefix ->
{Op, _} = Fun,
[A] = Args,
#unop{op = Op, rand = ast_body(A, Icode)};
_ ->
#funcall{function=ast_body(Fun, Icode),
args=[ast_body(A, Icode) || A <- Args]}
end;
ast_body({list_comp, _, Yield, []}, Icode) ->
#list{elems = [ast_body(Yield, Icode)]};
ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, Arg, ArgType}, BindExpr}|Rest]}, Icode) ->
#funcall
{ function = #var_ref{ name = ["ListInternal", "flat_map"] }
, args =
[ #lambda{ args=[#arg{name = ast_id(Arg), type = ast_type(ArgType, Icode)}]
, body = ast_body({list_comp, As, Yield, Rest}, Icode)
}
, ast_body(BindExpr, Icode)
]
};
ast_body({list_comp, As, Yield, [{comprehension_if, AsIF, Cond}|Rest]}, Icode) ->
ast_body({'if', AsIF, Cond, {list_comp, As, Yield, Rest}, {list, As, []}}, Icode);
ast_body({list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}, Icode) ->
ast_body({block, As, [LV, {list_comp, As, Yield, Rest}]}, Icode);
ast_body({list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}, Icode) ->
ast_body({block, As, [LF, {list_comp, As, Yield, Rest}]}, Icode);
ast_body({'if',_,Dec,Then,Else}, Icode) ->
#ifte{decision = ast_body(Dec, Icode)
,then = ast_body(Then, Icode)
,else = ast_body(Else, Icode)};
ast_body({switch,_,A,Cases}, Icode) ->
%% let's assume the parser has already ensured that only valid
%% patterns appear in cases.
#switch{expr=ast_body(A, Icode),
cases=[{ast_body(Pat, Icode),ast_body(Body, Icode)}
|| {'case',_,Pat,Body} <- Cases]};
ast_body({block,As,[{letval,_,Pat,_,E}|Rest]}, Icode) ->
#switch{expr=ast_body(E, Icode),
cases=[{ast_body(Pat, Icode),ast_body({block,As,Rest}, Icode)}]};
ast_body({block, As, [{letfun, Ann, F, Args, _Type, Expr} | Rest]}, Icode) ->
ast_body({block, As, [{letval, Ann, F, unused, {lam, Ann, Args, Expr}} | Rest]}, Icode);
ast_body({block,_,[]}, _Icode) ->
#tuple{cpts=[]};
ast_body({block,_,[E]}, Icode) ->
ast_body(E, Icode);
ast_body({block,As,[E|Rest]}, Icode) ->
#switch{expr=ast_body(E, Icode),
cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, Icode)}]};
ast_body({lam,_,Args,Body}, Icode) ->
#lambda{args=[#arg{name = ast_id(P), type = ast_type(T, Icode)} || {arg,_,P,T} <- Args],
body=ast_body(Body, Icode)};
ast_body({typed,_,{record,Attrs,Fields},{record_t,DefFields}}, Icode) ->
%% Compile as a tuple with the fields in the order they appear in the definition.
NamedField = fun({field, _, [{proj, _, {id, _, Name}}], E}) -> {Name, E} end,
NamedFields = lists:map(NamedField, Fields),
#tuple{cpts =
[case proplists:get_value(Name, NamedFields) of
undefined ->
Line = aeso_syntax:get_ann(line, Attrs),
#missing_field{format = "Missing field in record: ~s (on line ~p)\n",
args = [Name,Line]};
E ->
ast_body(E, Icode)
end
|| {field_t,_,{id,_,Name},_} <- DefFields]};
ast_body({typed,_,{record,Attrs,_Fields},T}, _Icode) ->
gen_error({record_has_bad_type,Attrs,T});
ast_body({proj,_,{typed,_,Record,{record_t,Fields}},{id,_,FieldName}}, Icode) ->
[Index] = [I
|| {I,{field_t,_,{id,_,Name},_}} <-
lists:zip(lists:seq(1,length(Fields)),Fields),
Name==FieldName],
#binop{op = '!', left = #integer{value = 32*(Index-1)}, right = ast_body(Record, Icode)};
ast_body({record, Attrs, {typed, _, Record, RecType={record_t, Fields}}, Update}, Icode) ->
UpdatedName = fun({field, _, [{proj, _, {id, _, Name}}], _}) -> Name;
({field_upd, _, [{proj, _, {id, _, Name}}], _}) -> Name
end,
UpdatedNames = lists:map(UpdatedName, Update),
Rec = {typed, Attrs, {id, Attrs, "_record"}, RecType},
CompileUpdate =
fun(Fld={field, _, _, _}) -> Fld;
({field_upd, Ann, LV=[{proj, Ann1, P}], Fun}) ->
{field, Ann, LV, {app, Ann, Fun, [{proj, Ann1, Rec, P}]}}
end,
#switch{expr=ast_body(Record, Icode),
cases=[{#var_ref{name = "_record"},
ast_body({typed, Attrs,
{record, Attrs,
lists:map(CompileUpdate, Update) ++
[{field, Attrs, [{proj, Attrs, {id, Attrs, Name}}],
{proj, Attrs, Rec, {id, Attrs, Name}}}
|| {field_t, _, {id, _, Name}, _} <- Fields,
not lists:member(Name, UpdatedNames)]},
RecType}, Icode)}
]};
ast_body({typed, _, Body, _}, Icode) ->
ast_body(Body, Icode).
ast_binop(Op, Ann, {typed, _, A, Type}, B, Icode)
when Op == '=='; Op == '!=';
Op == '<'; Op == '>';
Op == '<='; Op == '=<'; Op == '>=' ->
Monomorphic = is_monomorphic(Type),
case ast_typerep(Type, Icode) of
_ when not Monomorphic ->
gen_error({cant_compare_polymorphic_type, Ann, Op, Type});
word -> #binop{op = Op, left = ast_body(A, Icode), right = ast_body(B, Icode)};
OtherType ->
Neg = case Op of
'==' -> fun(X) -> X end;
'!=' -> fun(X) -> #unop{ op = '!', rand = X } end;
_ -> gen_error({cant_compare, Ann, Op, Type})
end,
Args = [ast_body(A, Icode), ast_body(B, Icode)],
Builtin =
case OtherType of
string ->
builtin_call(str_equal, Args);
{tuple, Types} ->
case lists:usort(Types) of
[word] ->
builtin_call(str_equal_p, [ #integer{value = 32 * length(Types)} | Args]);
_ -> gen_error({cant_compare, Ann, Op, Type})
end;
_ ->
gen_error({cant_compare, Ann, Op, Type})
end,
Neg(Builtin)
end;
ast_binop('++', _, A, B, Icode) ->
builtin_call(list_concat, [ast_body(A, Icode), ast_body(B, Icode)]);
ast_binop(Op, _, A, B, Icode) ->
#binop{op = Op, left = ast_body(A, Icode), right = ast_body(B, Icode)}.
check_monomorphic_map({typed, Ann, _, MapType}, Icode) ->
check_monomorphic_map(Ann, MapType, Icode).
check_monomorphic_map(Ann, Type = ?map_t(KeyType, ValType), Icode) ->
case is_monomorphic(KeyType) of
true ->
case has_maps(ast_type(KeyType, Icode)) of
false -> {KeyType, ValType};
true -> gen_error({cant_use_map_as_map_keys, Ann, Type})
end;
false -> gen_error({cant_compile_map_with_polymorphic_keys, Ann, Type})
end.
map_empty(KeyType, ValType, Icode) ->
prim_call(?PRIM_CALL_MAP_EMPTY, #integer{value = 0},
[ast_type_value(KeyType, Icode),
ast_type_value(ValType, Icode)],
[typerep, typerep], word).
map_get(Key, Map = {typed, Ann, _, MapType}, Icode) ->
{_KeyType, ValType} = check_monomorphic_map(Ann, MapType, Icode),
builtin_call({map_lookup, ast_type(ValType, Icode)}, [ast_body(Map, Icode), ast_body(Key, Icode)]).
map_put(Key, Val, Map, Icode) ->
builtin_call(map_put, [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Val, Icode)]).
map_del(Key, Map, Icode) ->
prim_call(?PRIM_CALL_MAP_DELETE, #integer{value = 0},
[ast_body(Map, Icode), ast_body(Key, Icode)],
[word, word], word).
map_tolist(Map, Icode) ->
{KeyType, ValType} = check_monomorphic_map(Map, Icode),
prim_call(?PRIM_CALL_MAP_TOLIST, #integer{value = 0},
[ast_body(Map, Icode)],
[word], {list, {tuple, [ast_type(KeyType, Icode), ast_type(ValType, Icode)]}}).
map_upd(Key, ValFun, Map = {typed, Ann, _, MapType}, Icode) ->
{_, ValType} = check_monomorphic_map(Ann, MapType, Icode),
FunName = {map_upd, ast_type(ValType, Icode)},
Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(ValFun, Icode)],
builtin_call(FunName, Args).
map_upd(Key, Default, ValFun, Map = {typed, Ann, _, MapType}, Icode) ->
{_, ValType} = check_monomorphic_map(Ann, MapType, Icode),
FunName = {map_upd_default, ast_type(ValType, Icode)},
Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Default, Icode), ast_body(ValFun, Icode)],
builtin_call(FunName, Args).
is_monomorphic({tvar, _, _}) -> false;
is_monomorphic([H|T]) ->
is_monomorphic(H) andalso is_monomorphic(T);
is_monomorphic(T) when is_tuple(T) ->
is_monomorphic(tuple_to_list(T));
is_monomorphic(_) -> true.
%% Implemented as a contract call to the contract with address 0.
prim_call(Prim, Amount, Args, ArgTypes, OutType) ->
TypeHash =
case aeb_primops:op_needs_type_check(Prim) of
true ->
PrimBin = binary:encode_unsigned(Prim),
ArgType = {tuple, ArgTypes},
<<TH:256>> = aeb_aevm_abi:function_type_hash(PrimBin, ArgType, OutType),
TH;
false ->
0
end,
#prim_call_contract{ gas = prim_gas_left,
address = #integer{ value = ?PRIM_CALLS_CONTRACT },
value = Amount,
arg = #tuple{cpts = [#integer{ value = Prim }| Args]},
type_hash= #integer{value = TypeHash}
}.
generic_hash_primop(PrimOp, Term, Type, Icode) ->
ArgType = ast_type(Type, Icode),
TypeValue = type_value(ArgType),
prim_call(PrimOp, #integer{value = 0},
[TypeValue, ast_body(Term, Icode)],
[typerep, ArgType], word).
string_hash_primop(PrimOp, String, Icode) ->
prim_call(PrimOp, #integer{value = 0}, [ast_body(String, Icode)], [string], word).
make_type_def(Args, Def, Icode = #{ type_vars := TypeEnv }) ->
TVars = [ X || {tvar, _, X} <- Args ],
fun(Types) ->
TypeEnv1 = maps:from_list(lists:zip(TVars, Types)),
ast_typerep(Def, Icode#{ type_vars := maps:merge(TypeEnv, TypeEnv1) })
end.
-spec ast_typerep(aeso_syntax:type()) -> aeb_aevm_data:type().
ast_typerep(Type) -> ast_typerep(Type, aeso_icode:new([])).
ast_typerep({id, _, Name}, Icode) ->
lookup_type_id(Name, [], Icode);
ast_typerep({qid, _, Name}, Icode) ->
lookup_type_id(Name, [], Icode);
ast_typerep({con, _, _}, _) ->
word; %% Contract type
ast_typerep({bytes_t, _, Len}, _) ->
bytes_t(Len);
ast_typerep({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid ->
ArgReps = [ ast_typerep(Arg, Icode) || Arg <- Args ],
lookup_type_id(Name, ArgReps, Icode);
ast_typerep({tvar,_,A}, #{ type_vars := TypeVars }) ->
case maps:get(A, TypeVars, undefined) of
undefined -> word; %% We serialize type variables just as addresses in the originating VM.
Type -> Type
end;
ast_typerep({tuple_t,_,Cpts}, Icode) ->
{tuple, [ast_typerep(C, Icode) || C<-Cpts]};
ast_typerep({record_t,Fields}, Icode) ->
{tuple, [ begin
{field_t, _, _, T} = Field,
ast_typerep(T, Icode)
end || Field <- Fields]};
ast_typerep({fun_t,_,_,_,_}, _Icode) ->
function;
ast_typerep({alias_t, T}, Icode) -> ast_typerep(T, Icode);
ast_typerep({variant_t, Cons}, Icode) ->
{variant, [ begin
{constr_t, _, _, Args} = Con,
[ ast_typerep(Arg, Icode) || Arg <- Args ]
end || Con <- Cons ]}.
ttl_t(Icode) ->
ast_typerep({qid, [], ["Chain", "ttl"]}, Icode).
sign_t() -> bytes_t(64).
bytes_t(Len) when Len =< 32 -> word;
bytes_t(Len) -> {tuple, lists:duplicate((31 + Len) div 32, word)}.
get_signature_arg(Args0) ->
NamedArgs = [Arg || Arg = {named_arg, _, _, _} <- Args0],
Args = Args0 -- NamedArgs,
DefaultVal = {tuple, [], [{int, [], 0}, {int, [], 0}]},
Sig =
case NamedArgs of
[] -> DefaultVal;
[{named_arg, _, _, Val}] -> Val
end,
{Sig, Args}.
lookup_type_id(Name, Args, #{ types := Types }) ->
case maps:get(Name, Types, undefined) of
undefined -> gen_error({undefined_type, Name});
TDef -> TDef(Args)
end.
ast_type_value(T, Icode) ->
type_value(ast_type(T, Icode)).
type_value(word) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_WORD_TAG }] };
type_value(string) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_STRING_TAG }] };
type_value(typerep) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_TYPEREP_TAG }] };
type_value({list, A}) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_LIST_TAG }, type_value(A)] };
type_value({tuple, As}) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_TUPLE_TAG },
#list{ elems = [ type_value(A) || A <- As ] }] };
type_value({variant, Cs}) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_VARIANT_TAG },
#list{ elems = [ #list{ elems = [ type_value(A) || A <- As ] } || As <- Cs ] }] };
type_value({map, K, V}) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG },
type_value(K), type_value(V)] }.
%% As abort is a built-in in the future it will be illegal to for
%% users to define abort. For the time being strip away all user
%% defined abort functions.
ast_fun_to_icode("abort", _Atts, _Args, _Body, _TypeRep, Icode) ->
%% Strip away all user defined abort functions.
Icode;
ast_fun_to_icode(Name, Attrs, Args, Body, TypeRep, #{functions := Funs} = Icode) ->
NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs],
aeso_icode:set_functions(NewFuns, Icode).
has_maps({map, _, _}) -> true;
has_maps(word) -> false;
has_maps(string) -> false;
has_maps(typerep) -> false;
has_maps({list, T}) -> has_maps(T);
has_maps({tuple, Ts}) -> lists:any(fun has_maps/1, Ts);
has_maps({variant, Cs}) -> lists:any(fun has_maps/1, lists:append(Cs)).
%% A function is private if not an 'entrypoint', or if it's not defined in the
%% main contract name space. (NOTE: changes when we introduce inheritance).
is_private(Ann, #{ contract_name := MainContract } = Icode) ->
{_, _, CurrentNamespace} = aeso_icode:get_namespace(Icode),
not proplists:get_value(entrypoint, Ann, false) orelse
MainContract /= CurrentNamespace.
%% -------------------------------------------------------------------
%% Builtins
%% -------------------------------------------------------------------
builtin_call(Builtin, Args) ->
#funcall{ function = #var_ref{ name = {builtin, Builtin} },
args = Args }.
add_builtins(Icode = #{functions := Funs}) ->
Builtins = aeso_builtins:used_builtins(Funs),
Icode#{functions := [ aeso_builtins:builtin_function(B) || B <- Builtins ] ++ Funs}.
%% -------------------------------------------------------------------
%% Deadcode elimination
%% -------------------------------------------------------------------
deadcode_elimination(Icode = #{ functions := Funs }) ->
PublicNames = [ Name || {Name, Ann, _, _, _} <- Funs, not lists:member(private, Ann) ],
ArgsToPat = fun(Args) -> [ #var_ref{ name = X } || {X, _} <- Args ] end,
Defs = maps:from_list([ {Name, {binder, ArgsToPat(Args), Body}} || {Name, _, Args, Body, _} <- Funs ]),
UsedNames = chase_names(Defs, PublicNames, #{}),
UsedFuns = [ Def || Def = {Name, _, _, _, _} <- Funs, maps:is_key(Name, UsedNames) ],
Icode#{ functions := UsedFuns }.
chase_names(_Defs, [], Used) -> Used;
chase_names(Defs, [X | Xs], Used) ->
%% can happen when compiling __call contracts
case maps:is_key(X, Used) orelse not maps:is_key(X, Defs) of
true -> chase_names(Defs, Xs, Used); %% already chased
false ->
Def = maps:get(X, Defs),
Vars = maps:keys(free_vars(Def)),
chase_names(Defs, Vars ++ Xs, Used#{ X => true })
end.
free_vars(#var_ref{ name = X }) -> #{ X => true };
free_vars(#arg{ name = X }) -> #{ X => true };
free_vars({binder, Pat, Body}) ->
maps:without(maps:keys(free_vars(Pat)), free_vars(Body));
free_vars(#switch{ expr = E, cases = Cases }) ->
free_vars([E | [{binder, P, B} || {P, B} <- Cases]]);
free_vars(#lambda{ args = Xs, body = E }) ->
free_vars({binder, Xs, E});
free_vars(T) when is_tuple(T) -> free_vars(tuple_to_list(T));
free_vars([H | T]) -> maps:merge(free_vars(H), free_vars(T));
free_vars(_) -> #{}.

577
src/aeso_builtins.erl Normal file
View File

@ -0,0 +1,577 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2018, Aeternity Anstalt
%%% @doc
%%% Compiler builtin functions for Aeterinty Sophia language.
%%% @end
%%% Created : 20 Dec 2018
%%%
%%%-------------------------------------------------------------------
-module(aeso_builtins).
-export([ builtin_function/1
, check_event_type/1
, used_builtins/1 ]).
-import(aeso_ast_to_icode, [prim_call/5]).
-include_lib("aebytecode/include/aeb_opcodes.hrl").
-include("aeso_icode.hrl").
used_builtins(#funcall{ function = #var_ref{ name = {builtin, Builtin} }, args = Args }) ->
lists:umerge(dep_closure([Builtin]), used_builtins(Args));
used_builtins([H|T]) ->
lists:umerge(used_builtins(H), used_builtins(T));
used_builtins(T) when is_tuple(T) ->
used_builtins(tuple_to_list(T));
used_builtins(M) when is_map(M) ->
used_builtins(maps:to_list(M));
used_builtins(_) -> [].
builtin_deps(Builtin) ->
lists:usort(builtin_deps1(Builtin)).
builtin_deps1({map_lookup_default, Type}) -> [{map_lookup, Type}];
builtin_deps1({map_get, Type}) -> [{map_lookup, Type}];
builtin_deps1(map_member) -> [{map_lookup, word}];
builtin_deps1({map_upd, Type}) -> [{map_get, Type}, map_put];
builtin_deps1({map_upd_default, Type}) -> [{map_lookup_default, Type}, map_put];
builtin_deps1(map_from_list) -> [map_put];
builtin_deps1(str_equal) -> [str_equal_p];
builtin_deps1(string_concat) -> [string_concat_inner1, string_copy, string_shift_copy];
builtin_deps1(int_to_str) -> [{baseX_int, 10}];
builtin_deps1(addr_to_str) -> [{baseX_int, 58}];
builtin_deps1({baseX_int, X}) -> [{baseX_int_pad, X}];
builtin_deps1({baseX_int_pad, X}) -> [{baseX_int_encode, X}];
builtin_deps1({baseX_int_encode, X}) -> [{baseX_int_encode_, X}, {baseX_tab, X}, {baseX_digits, X}];
builtin_deps1({bytes_to_str, _}) -> [bytes_to_str_worker];
builtin_deps1(string_reverse) -> [string_reverse_];
builtin_deps1(require) -> [abort];
builtin_deps1(_) -> [].
dep_closure(Deps) ->
case lists:umerge(lists:map(fun builtin_deps/1, Deps)) of
[] -> Deps;
Deps1 -> lists:umerge(Deps, dep_closure(Deps1))
end.
%% Helper functions/macros
v(X) when is_atom(X) -> v(atom_to_list(X));
v(X) when is_list(X) -> #var_ref{name = X}.
option_none() -> {tuple, [{integer, 0}]}.
option_some(X) -> {tuple, [{integer, 1}, X]}.
-define(HASH_BYTES, 32).
-define(call(Fun, Args), #funcall{ function = #var_ref{ name = {builtin, Fun} }, args = Args }).
-define(I(X), {integer, X}).
-define(V(X), v(X)).
-define(A(Op), aeb_opcodes:mnemonic(Op)).
-define(LET(Var, Expr, Body), {switch, Expr, [{v(Var), Body}]}).
-define(DEREF(Var, Ptr, Body), {switch, operand(Ptr), [{{tuple, [v(Var)]}, Body}]}).
-define(NXT(Ptr), op('+', Ptr, 32)).
-define(NEG(A), op('/', A, {unop, '-', {integer, 1}})).
-define(BYTE(Ix, Word), op('byte', Ix, Word)).
-define(EQ(A, B), op('==', A, B)).
-define(LT(A, B), op('<', A, B)).
-define(GT(A, B), op('>', A, B)).
-define(ADD(A, B), op('+', A, B)).
-define(SUB(A, B), op('-', A, B)).
-define(MUL(A, B), op('*', A, B)).
-define(DIV(A, B), op('div', A, B)).
-define(MOD(A, B), op('mod', A, B)).
-define(EXP(A, B), op('^', A, B)).
-define(AND(A, B), op('&&', A, B)).
%% Bit shift operations takes their arguments backwards!?
-define(BSL(X, B), op('bsl', ?MUL(B, 8), X)).
-define(BSR(X, B), op('bsr', ?MUL(B, 8), X)).
op(Op, A, B) -> {binop, Op, operand(A), operand(B)}.
operand(A) when is_atom(A) -> v(A);
operand(I) when is_integer(I) -> {integer, I};
operand(T) -> T.
check_event_type(Icode) ->
case maps:get(event_type, Icode) of
{variant_t, Cons} ->
check_event_type(Cons, Icode);
_ ->
error({event_should_be_variant_type})
end.
check_event_type(Evts, Icode) ->
[ check_event_type(Name, Ix, T, Icode)
|| {constr_t, Ann, {con, _, Name}, Types} <- Evts,
{Ix, T} <- lists:zip(aeso_syntax:get_ann(indices, Ann), Types) ].
check_event_type(EvtName, Ix, Type, Icode) ->
VMType =
try
aeso_ast_to_icode:ast_typerep(Type, Icode)
catch _:_ ->
error({EvtName, could_not_resolve_type, Type})
end,
case {Ix, VMType, Type} of
{indexed, word, _} -> ok;
{notindexed, string, _} -> ok;
{notindexed, _, {bytes_t, _, N}} when N > 32 -> ok;
{indexed, _, _} -> error({EvtName, indexed_field_should_be_word, is, VMType});
{notindexed, _, _} -> error({EvtName, payload_should_be_string, is, VMType})
end.
bfun(B, {IArgs, IExpr, IRet}) ->
{{builtin, B}, [private], IArgs, IExpr, IRet}.
builtin_function(BF) ->
case BF of
{event, EventT} -> bfun(BF, builtin_event(EventT));
abort -> bfun(BF, builtin_abort());
block_hash -> bfun(BF, builtin_block_hash());
require -> bfun(BF, builtin_require());
{map_lookup, Type} -> bfun(BF, builtin_map_lookup(Type));
map_put -> bfun(BF, builtin_map_put());
map_delete -> bfun(BF, builtin_map_delete());
map_size -> bfun(BF, builtin_map_size());
{map_get, Type} -> bfun(BF, builtin_map_get(Type));
{map_lookup_default, Type} -> bfun(BF, builtin_map_lookup_default(Type));
map_member -> bfun(BF, builtin_map_member());
{map_upd, Type} -> bfun(BF, builtin_map_upd(Type));
{map_upd_default, Type} -> bfun(BF, builtin_map_upd_default(Type));
map_from_list -> bfun(BF, builtin_map_from_list());
list_concat -> bfun(BF, builtin_list_concat());
string_length -> bfun(BF, builtin_string_length());
string_concat -> bfun(BF, builtin_string_concat());
string_concat_inner1 -> bfun(BF, builtin_string_concat_inner1());
string_copy -> bfun(BF, builtin_string_copy());
string_shift_copy -> bfun(BF, builtin_string_shift_copy());
str_equal_p -> bfun(BF, builtin_str_equal_p());
str_equal -> bfun(BF, builtin_str_equal());
popcount -> bfun(BF, builtin_popcount());
int_to_str -> bfun(BF, builtin_int_to_str());
addr_to_str -> bfun(BF, builtin_addr_to_str());
{baseX_int, X} -> bfun(BF, builtin_baseX_int(X));
{baseX_digits, X} -> bfun(BF, builtin_baseX_digits(X));
{baseX_tab, X} -> bfun(BF, builtin_baseX_tab(X));
{baseX_int_pad, X} -> bfun(BF, builtin_baseX_int_pad(X));
{baseX_int_encode, X} -> bfun(BF, builtin_baseX_int_encode(X));
{baseX_int_encode_, X} -> bfun(BF, builtin_baseX_int_encode_(X));
{bytes_to_int, N} -> bfun(BF, builtin_bytes_to_int(N));
{bytes_to_str, N} -> bfun(BF, builtin_bytes_to_str(N));
bytes_to_str_worker -> bfun(BF, builtin_bytes_to_str_worker());
string_reverse -> bfun(BF, builtin_string_reverse());
string_reverse_ -> bfun(BF, builtin_string_reverse_())
end.
%% Event primitive (dependent on Event type)
%%
%% We need to switch on the event and prepare the correct #event for icode_to_asm
%% NOTE: we assume all errors are already checked!
builtin_event(EventT) ->
A = fun(X) -> aeb_opcodes:mnemonic(X) end,
VIx = fun(Ix) -> v(lists:concat(["v", Ix])) end,
ArgPats = fun(Ts) -> [ VIx(Ix) || Ix <- lists:seq(0, length(Ts) - 1) ] end,
Payload = %% Should put data ptr, length on stack.
fun([]) -> {inline_asm, [A(?PUSH1), 0, A(?PUSH1), 0]};
([{{id, _, "string"}, V}]) ->
{seq, [V, {inline_asm, [A(?DUP1), A(?MLOAD), %% length, ptr
A(?SWAP1), A(?PUSH1), 32, A(?ADD)]}]}; %% ptr+32, length
([{{bytes_t, _, N}, V}]) -> {seq, [V, {integer, N}, {inline_asm, A(?SWAP1)}]}
end,
Ix =
fun({bytes_t, _, N}, V) when N < 32 -> ?BSR(V, 32 - N);
(_, V) -> V end,
Clause =
fun(_Tag, {con, _, Con}, IxTypes) ->
Types = [ T || {_Ix, T} <- IxTypes ],
Indexed = [ Ix(Type, Var) || {Var, {indexed, Type}} <- lists:zip(ArgPats(Types), IxTypes) ],
Data = [ {Type, Var} || {Var, {notindexed, Type}} <- lists:zip(ArgPats(Types), IxTypes) ],
{ok, <<EvtIndexN:256>>} = eblake2:blake2b(?HASH_BYTES, list_to_binary(Con)),
EvtIndex = {integer, EvtIndexN},
{event, lists:reverse(Indexed) ++ [EvtIndex], Payload(Data)}
end,
Pat = fun(Tag, Types) -> {tuple, [{integer, Tag} | ArgPats(Types)]} end,
{variant_t, Cons} = EventT,
Tags = lists:seq(0, length(Cons) - 1),
{[{"e", event}],
{switch, v(e),
[{Pat(Tag, Types), Clause(Tag, Con, lists:zip(aeso_syntax:get_ann(indices, Ann), Types))}
|| {Tag, {constr_t, Ann, Con, Types}} <- lists:zip(Tags, Cons) ]},
{tuple, []}}.
%% Abort primitive.
builtin_abort() ->
A = fun(X) -> aeb_opcodes:mnemonic(X) end,
{[{"s", string}],
{inline_asm, [A(?PUSH1),0, %% Push a dummy 0 for the first arg
A(?REVERT)]}, %% Stack: 0,Ptr
{tuple,[]}}.
builtin_block_hash() ->
{[{"height", word}],
?LET(hash, #prim_block_hash{ height = ?V(height)},
{ifte, ?EQ(hash, 0), option_none(), option_some(?V(hash))}),
aeso_icode:option_typerep(word)}.
builtin_require() ->
{[{"c", word}, {"msg", string}],
{ifte, ?V(c), {tuple, []}, ?call(abort, [?V(msg)])},
{tuple, []}}.
%% Map primitives
builtin_map_lookup(Type) ->
Ret = aeso_icode:option_typerep(Type),
{[{"m", word}, {"k", word}],
prim_call(?PRIM_CALL_MAP_GET, #integer{value = 0},
[#var_ref{name = "m"}, #var_ref{name = "k"}],
[word, word], Ret),
Ret}.
builtin_map_put() ->
%% We don't need the types for put.
{[{"m", word}, {"k", word}, {"v", word}],
prim_call(?PRIM_CALL_MAP_PUT, #integer{value = 0},
[v(m), v(k), v(v)], [word, word, word], word),
word}.
builtin_map_delete() ->
{[{"m", word}, {"k", word}],
prim_call(?PRIM_CALL_MAP_DELETE, #integer{value = 0},
[v(m), v(k)], [word, word], word),
word}.
builtin_map_size() ->
{[{"m", word}],
prim_call(?PRIM_CALL_MAP_SIZE, #integer{value = 0},
[v(m)], [word], word),
word}.
%% Map builtins
builtin_map_get(Type) ->
%% function map_get(m, k) =
%% switch(map_lookup(m, k))
%% Some(v) => v
{[{"m", word}, {"k", word}],
{switch, ?call({map_lookup, Type}, [v(m), v(k)]), [{option_some(v(v)), v(v)}]},
Type}.
builtin_map_lookup_default(Type) ->
%% function map_lookup_default(m, k, default) =
%% switch(map_lookup(m, k))
%% None => default
%% Some(v) => v
{[{"m", word}, {"k", word}, {"default", Type}],
{switch, ?call({map_lookup, Type}, [v(m), v(k)]),
[{option_none(), v(default)},
{option_some(v(v)), v(v)}]},
Type}.
builtin_map_member() ->
%% function map_member(m, k) : bool =
%% switch(Map.lookup(m, k))
%% None => false
%% _ => true
{[{"m", word}, {"k", word}],
{switch, ?call({map_lookup, word}, [v(m), v(k)]),
[{option_none(), {integer, 0}},
{{var_ref, "_"}, {integer, 1}}]},
word}.
builtin_map_upd(Type) ->
%% function map_upd(map, key, fun) =
%% map_put(map, key, fun(map_get(map, key)))
{[{"map", word}, {"key", word}, {"valfun", word}],
?call(map_put,
[v(map), v(key),
#funcall{ function = v(valfun),
args = [?call({map_get, Type}, [v(map), v(key)])] }]),
word}.
builtin_map_upd_default(Type) ->
%% function map_upd(map, key, val, fun) =
%% map_put(map, key, fun(map_lookup_default(map, key, val)))
{[{"map", word}, {"key", word}, {"val", word}, {"valfun", word}],
?call(map_put,
[v(map), v(key),
#funcall{ function = v(valfun),
args = [?call({map_lookup_default, Type}, [v(map), v(key), v(val)])] }]),
word}.
builtin_map_from_list() ->
%% function map_from_list(xs, acc) =
%% switch(xs)
%% [] => acc
%% (k, v) :: xs => map_from_list(xs, acc { [k] = v })
{[{"xs", {list, {tuple, [word, word]}}}, {"acc", word}],
{switch, v(xs),
[{{list, []}, v(acc)},
{{binop, '::', {tuple, [v(k), v(v)]}, v(ys)},
?call(map_from_list,
[v(ys), ?call(map_put, [v(acc), v(k), v(v)])])}]},
word}.
%% list_concat
%%
%% Concatenates two lists.
builtin_list_concat() ->
{[{"l1", {list, word}}, {"l2", {list, word}}],
{switch, v(l1),
[{{list, []}, v(l2)},
{{binop, '::', v(hd), v(tl)},
{binop, '::', v(hd), ?call(list_concat, [v(tl), v(l2)])}}
]
},
word}.
builtin_string_length() ->
%% function length(str) =
%% switch(str)
%% {n} -> n // (ab)use the representation
{[{"s", string}],
?DEREF(n, s, ?V(n)),
word}.
%% str_concat - concatenate two strings
%%
%% Unless the second string is the empty string, a new string is created at the
%% top of the Heap and the address to it is returned. The tricky bit is when
%% the words from the second string has to be shifted to fit next to the first
%% string.
builtin_string_concat() ->
{[{"s1", string}, {"s2", string}],
?DEREF(n1, s1,
?DEREF(n2, s2,
{ifte, ?EQ(n1, 0),
?V(s2), %% First string is empty return second string
{ifte, ?EQ(n2, 0),
?V(s1), %% Second string is empty return first string
?LET(ret, {inline_asm, [?A(?MSIZE)]},
{seq, [?ADD(n1, n2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, %% Store total len
?call(string_concat_inner1, [?V(n1), ?NXT(s1), ?V(n2), ?NXT(s2)]),
{inline_asm, [?A(?POP)]}, %% Discard fun ret val
?V(ret) %% Put the actual return value
]})}
}
)),
word}.
builtin_string_concat_inner1() ->
%% Copy all whole words from the first string, and set up for word fusion
%% Special case when the length of the first string is divisible by 32.
{[{"n1", word}, {"p1", pointer}, {"n2", word}, {"p2", pointer}],
?LET(w1, ?call(string_copy, [?V(n1), ?V(p1)]),
?LET(nx, ?MOD(n1, 32),
{ifte, ?EQ(nx, 0),
?LET(w2, ?call(string_copy, [?V(n2), ?V(p2)]),
{seq, [?V(w2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]}),
?call(string_shift_copy, [?V(nx), ?V(w1), ?V(n2), ?V(p2)])
})),
word}.
builtin_string_copy() ->
{[{"n", word}, {"p", pointer}],
?DEREF(w, p,
{ifte, ?GT(n, 31),
{seq, [?V(w), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
?call(string_copy, [?SUB(n, 32), ?NXT(p)])]},
?V(w)
}),
word}.
builtin_string_shift_copy() ->
{[{"off", word}, {"dst", word}, {"n", word}, {"p", pointer}],
?DEREF(w, p,
{seq, [?ADD(dst, ?BSR(w, off)), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
{ifte, ?GT(n, ?SUB(32, off)),
?call(string_shift_copy, [?V(off), ?BSL(w, ?SUB(32, off)), ?SUB(n, 32), ?NXT(p)]),
{inline_asm, [?A(?MSIZE)]}}]
}),
word}.
builtin_str_equal_p() ->
%% function str_equal_p(n, p1, p2) =
%% if(n =< 0) true
%% else
%% let w1 = *p1
%% let w2 = *p2
%% w1 == w2 && str_equal_p(n - 32, p1 + 32, p2 + 32)
{[{"n", word}, {"p1", pointer}, {"p2", pointer}],
{ifte, ?LT(n, 1),
?I(1),
?DEREF(w1, p1,
?DEREF(w2, p2,
?AND(?EQ(w1, w2),
?call(str_equal_p, [?SUB(n, 32), ?NXT(p1), ?NXT(p2)]))))},
word}.
builtin_str_equal() ->
%% function str_equal(s1, s2) =
%% let n1 = length(s1)
%% let n2 = length(s2)
%% n1 == n2 && str_equal_p(n1, s1 + 32, s2 + 32)
{[{"s1", string}, {"s2", string}],
?DEREF(n1, s1,
?DEREF(n2, s2,
?AND(?EQ(n1, n2), ?call(str_equal_p, [?V(n1), ?NXT(s1), ?NXT(s2)]))
)),
word}.
%% Count the number of 1s in a bit field.
builtin_popcount() ->
%% function popcount(bits, acc) =
%% if (bits == 0) acc
%% else popcount(bits bsr 1, acc + bits band 1)
{[{"bits", word}, {"acc", word}],
{ifte, ?EQ(bits, 0),
?V(acc),
?call(popcount, [op('bsr', 1, bits), ?ADD(acc, op('band', bits, 1))])
}, word}.
builtin_int_to_str() ->
{[{"i", word}], ?call({baseX_int, 10}, [?V(i)]), word}.
builtin_baseX_tab(_X = 10) ->
{[{"ix", word}], ?ADD($0, ix), word};
builtin_baseX_tab(_X = 58) ->
<<Fst32:256>> = <<"123456789ABCDEFGHJKLMNPQRSTUVWXY">>,
<<Lst26:256>> = <<"Zabcdefghijkmnopqrstuvwxyz", 0:48>>,
{[{"ix", word}],
{ifte, ?LT(ix, 32),
?BYTE(ix, Fst32),
?BYTE(?SUB(ix, 32), Lst26)
},
word}.
builtin_baseX_int(X) ->
{[{"w", word}],
?LET(ret, {inline_asm, [?A(?MSIZE)]},
{seq, [?call({baseX_int_pad, X}, [?V(w), ?I(0), ?I(0)]), {inline_asm, [?A(?POP)]}, ?V(ret)]}),
word}.
builtin_baseX_int_pad(X = 10) ->
{[{"src", word}, {"ix", word}, {"dst", word}],
{ifte, ?LT(src, 0),
?call({baseX_int_encode, X}, [?NEG(src), ?I(1), ?BSL($-, 31)]),
?call({baseX_int_encode, X}, [?V(src), ?V(ix), ?V(dst)])},
word};
builtin_baseX_int_pad(X = 16) ->
{[{"src", word}, {"ix", word}, {"dst", word}],
?call({baseX_int_encode, X}, [?V(src), ?V(ix), ?V(dst)]),
word};
builtin_baseX_int_pad(X = 58) ->
{[{"src", word}, {"ix", word}, {"dst", word}],
{ifte, ?GT(?ADD(?DIV(ix, 31), ?BYTE(ix, src)), 0),
?call({baseX_int_encode, X}, [?V(src), ?V(ix), ?V(dst)]),
?call({baseX_int_pad, X}, [?V(src), ?ADD(ix, 1), ?ADD(dst, ?BSL($1, ?SUB(31, ix)))])},
word}.
builtin_baseX_int_encode(X) ->
{[{"src", word}, {"ix", word}, {"dst", word}],
?LET(n, ?call({baseX_digits, X}, [?V(src), ?I(0)]),
{seq, [?ADD(n, ?ADD(ix, 1)), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
?call({baseX_int_encode_, X}, [?V(src), ?V(dst), ?EXP(X, n), ?V(ix)])]}),
word}.
builtin_baseX_int_encode_(X) ->
{[{"src", word}, {"dst", word}, {"fac", word}, {"ix", word}],
{ifte, ?EQ(fac, 0),
{seq, [?V(dst), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]},
{ifte, ?EQ(ix, 32),
%% We've filled a word, write it and start on new word
{seq, [?V(dst), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
?call({baseX_int_encode_, X}, [?V(src), ?I(0), ?V(fac), ?I(0)])]},
?call({baseX_int_encode_, X},
[?MOD(src, fac), ?ADD(dst, ?BSL(?call({baseX_tab, X}, [?DIV(src, fac)]), ?SUB(31, ix))),
?DIV(fac, X), ?ADD(ix, 1)])}
},
word}.
builtin_baseX_digits(X) ->
{[{"x0", word}, {"dgts", word}],
?LET(x1, ?DIV(x0, X),
{ifte, ?EQ(x1, 0), ?V(dgts), ?call({baseX_digits, X}, [?V(x1), ?ADD(dgts, 1)])}),
word}.
builtin_bytes_to_int(32) ->
{[{"w", word}], ?V(w), word};
builtin_bytes_to_int(N) when N < 32 ->
{[{"w", word}], ?BSR(w, 32 - N), word};
builtin_bytes_to_int(N) when N > 32 ->
LastFullWord = N div 32 - 1,
Body = case N rem 32 of
0 -> ?DEREF(n, ?ADD(b, LastFullWord * 32), ?V(n));
R ->
?DEREF(hi, ?ADD(b, LastFullWord * 32),
?DEREF(lo, ?ADD(b, (LastFullWord + 1) * 32),
?ADD(?BSR(lo, 32 - R), ?BSL(hi, R))))
end,
{[{"b", pointer}], Body, word}.
builtin_bytes_to_str_worker() ->
<<Tab:256>> = <<"0123456789ABCDEF________________">>,
{[{"w", word}, {"offs", word}, {"acc", word}],
{seq, [{ifte, ?AND(?GT(offs, 0), ?EQ(0, ?MOD(offs, 16))),
{seq, [?V(acc), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}]},
{inline_asm, []}},
{ifte, ?EQ(offs, 32), {inline_asm, [?A(?MSIZE)]},
?LET(b, ?BYTE(offs, w),
?LET(lo, ?BYTE(?MOD(b, 16), Tab),
?LET(hi, ?BYTE(op('bsr', 4 , b), Tab),
?call(bytes_to_str_worker,
[?V(w), ?ADD(offs, 1), ?ADD(?BSL(acc, 2), ?ADD(?BSL(hi, 1), lo))]))))
}
]},
word}.
builtin_bytes_to_str(N) when N =< 32 ->
{[{"w", word}],
?LET(ret, {inline_asm, [?A(?MSIZE)]},
{seq, [?I(N * 2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
?call(bytes_to_str_worker, [?V(w), ?I(0), ?I(0)]),
{inline_asm, [?A(?POP)]},
?V(ret)]}),
string};
builtin_bytes_to_str(N) when N > 32 ->
Work = fun(I) ->
[?DEREF(w, ?ADD(p, 32 * I), ?call(bytes_to_str_worker, [?V(w), ?I(0), ?I(0)])),
{inline_asm, [?A(?POP)]}]
end,
{[{"p", pointer}],
?LET(ret, {inline_asm, [?A(?MSIZE)]},
{seq, [?I(N * 2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}] ++
lists:append([ Work(I) || I <- lists:seq(0, (N + 31) div 32 - 1) ]) ++
[?V(ret)]}),
string}.
builtin_string_reverse() ->
{[{"s", string}],
?DEREF(n, s,
?LET(ret, {inline_asm, [?A(?MSIZE)]},
{seq, [?V(n), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
?call(string_reverse_, [?NXT(s), ?I(0), ?I(31), ?SUB(?V(n), 1)]),
{inline_asm, [?A(?POP)]}, ?V(ret)]})),
word}.
builtin_string_reverse_() ->
{[{"p", pointer}, {"x", word}, {"i1", word}, {"i2", word}],
{ifte, ?LT(i2, 0),
{seq, [?V(x), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]},
?LET(p1, ?ADD(p, ?MUL(?DIV(i2, 32), 32)),
?DEREF(w, p1,
?LET(b, ?BYTE(?MOD(i2, 32), w),
{ifte, ?LT(i1, 0),
{seq, [?V(x), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]},
?call(string_reverse_,
[?V(p), ?BSL(b, 31), ?I(30), ?SUB(i2, 1)])]},
?call(string_reverse_,
[?V(p), ?ADD(x, ?BSL(b, i1)), ?SUB(i1, 1), ?SUB(i2, 1)])})))},
word}.
builtin_addr_to_str() ->
{[{"a", word}], ?call({baseX_int, 58}, [?V(a)]), word}.

618
src/aeso_compiler.erl Normal file
View File

@ -0,0 +1,618 @@
%%%-------------------------------------------------------------------
%%% @author Happi (Erik Stenman)
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc
%%% Compiler from Aeterinty Sophia language to the Aeternity VM, aevm.
%%% @end
%%% Created : 12 Dec 2017
%%%-------------------------------------------------------------------
-module(aeso_compiler).
-export([ file/1
, file/2
, from_string/2
, check_call/4
, create_calldata/3 %% deprecated
, create_calldata/4
, version/0
, sophia_type_to_typerep/1
, to_sophia_value/4 %% deprecated, need a backend
, to_sophia_value/5
, decode_calldata/3 %% deprecated
, decode_calldata/4
, parse/2
, add_include_path/2
]).
-include_lib("aebytecode/include/aeb_opcodes.hrl").
-include("aeso_icode.hrl").
-type option() :: pp_sophia_code
| pp_ast
| pp_types
| pp_typed_ast
| pp_icode
| pp_assembler
| pp_bytecode
| no_code
| {backend, aevm | fate}
| {include, {file_system, [string()]} |
{explicit_files, #{string() => binary()}}}
| {src_file, string()}.
-type options() :: [option()].
-export_type([ option/0
, options/0
]).
-spec version() -> {ok, binary()} | {error, term()}.
version() ->
case lists:keyfind(aesophia, 1, application:loaded_applications()) of
false ->
case application:load(aesophia) of
ok ->
case application:get_key(aesophia, vsn) of
{ok, VsnString} ->
{ok, list_to_binary(VsnString)};
undefined ->
{error, failed_to_load_aesophia}
end;
Err = {error, _} ->
Err
end;
{_App, _Des, VsnString} ->
{ok, list_to_binary(VsnString)}
end.
-spec file(string()) -> {ok, map()} | {error, binary()}.
file(Filename) ->
file(Filename, []).
-spec file(string(), options()) -> {ok, map()} | {error, binary()}.
file(File, Options0) ->
Options = add_include_path(File, Options0),
case read_contract(File) of
{ok, Bin} -> from_string(Bin, [{src_file, File} | Options]);
{error, Error} ->
ErrorString = [File,": ",file:format_error(Error)],
{error, join_errors("File errors", [ErrorString], fun(E) -> E end)}
end.
add_include_path(File, Options) ->
case lists:keymember(include, 1, Options) of
true -> Options;
false ->
Dir = filename:dirname(File),
{ok, Cwd} = file:get_cwd(),
[{include, {file_system, [Cwd, Dir]}} | Options]
end.
-spec from_string(binary() | string(), options()) -> {ok, map()} | {error, binary()}.
from_string(Contract, Options) ->
from_string(proplists:get_value(backend, Options, aevm), Contract, Options).
from_string(Backend, ContractBin, Options) when is_binary(ContractBin) ->
from_string(Backend, binary_to_list(ContractBin), Options);
from_string(Backend, ContractString, Options) ->
try
from_string1(Backend, ContractString, Options)
catch
%% The compiler errors.
error:{parse_errors, Errors} ->
{error, join_errors("Parse errors", Errors, fun(E) -> E end)};
error:{type_errors, Errors} ->
{error, join_errors("Type errors", Errors, fun(E) -> E end)};
error:{code_errors, Errors} ->
{error, join_errors("Code errors", Errors,
fun (E) -> io_lib:format("~p", [E]) end)}
%% General programming errors in the compiler just signal error.
end.
from_string1(aevm, ContractString, Options) ->
#{icode := Icode} = string_to_code(ContractString, Options),
TypeInfo = extract_type_info(Icode),
Assembler = assemble(Icode, Options),
pp_assembler(Assembler, Options),
ByteCodeList = to_bytecode(Assembler, Options),
ByteCode = << << B:8 >> || B <- ByteCodeList >>,
pp_bytecode(ByteCode, Options),
{ok, Version} = version(),
{ok, #{byte_code => ByteCode,
compiler_version => Version,
contract_source => ContractString,
type_info => TypeInfo,
abi_version => aeb_aevm_abi:abi_version(),
payable => maps:get(payable, Icode)
}};
from_string1(fate, ContractString, Options) ->
#{fcode := FCode} = string_to_code(ContractString, Options),
FateCode = aeso_fcode_to_fate:compile(FCode, Options),
ByteCode = aeb_fate_code:serialize(FateCode, []),
{ok, Version} = version(),
{ok, #{byte_code => ByteCode,
compiler_version => Version,
contract_source => ContractString,
type_info => [],
fate_code => FateCode,
abi_version => aeb_fate_abi:abi_version(),
payable => maps:get(payable, FCode)
}}.
-spec string_to_code(string(), options()) -> map().
string_to_code(ContractString, Options) ->
Ast = parse(ContractString, Options),
pp_sophia_code(Ast, Options),
pp_ast(Ast, Options),
{TypeEnv, TypedAst} = aeso_ast_infer_types:infer(Ast, [return_env]),
pp_typed_ast(TypedAst, Options),
case proplists:get_value(backend, Options, aevm) of
aevm ->
Icode = ast_to_icode(TypedAst, Options),
pp_icode(Icode, Options),
#{ icode => Icode,
typed_ast => TypedAst,
type_env => TypeEnv};
fate ->
Fcode = aeso_ast_to_fcode:ast_to_fcode(TypedAst, Options),
#{ fcode => Fcode,
typed_ast => TypedAst,
type_env => TypeEnv}
end.
join_errors(Prefix, Errors, Pfun) ->
Ess = [ Pfun(E) || E <- Errors ],
list_to_binary(string:join([Prefix|Ess], "\n")).
-define(CALL_NAME, "__call").
-define(DECODE_NAME, "__decode").
%% Takes a string containing a contract with a declaration/prototype of a
%% function (foo, say) and adds function __call() = foo(args) calling this
%% function. Returns the name of the called functions, typereps and Erlang
%% terms for the arguments.
%% NOTE: Special treatment for "init" since it might be implicit and has
%% a special return type (typerep, T)
-spec check_call(string(), string(), [string()], options()) -> {ok, string(), {[Type], Type}, [term()]}
| {ok, string(), [term()]}
| {error, term()}
when Type :: term().
check_call(Source, "init" = FunName, Args, Options) ->
case check_call1(Source, FunName, Args, Options) of
Err = {error, _} when Args == [] ->
%% Try with default init-function
case check_call1(insert_init_function(Source, Options), FunName, Args, Options) of
{error, _} -> Err; %% The first error is most likely better...
Res -> Res
end;
Res ->
Res
end;
check_call(Source, FunName, Args, Options) ->
check_call1(Source, FunName, Args, Options).
check_call1(ContractString0, FunName, Args, Options) ->
try
case proplists:get_value(backend, Options, aevm) of
aevm ->
%% First check the contract without the __call function
#{} = string_to_code(ContractString0, Options),
ContractString = insert_call_function(ContractString0, ?CALL_NAME, FunName, Args, Options),
#{typed_ast := TypedAst,
icode := Icode} = string_to_code(ContractString, Options),
{ok, {FunName, {fun_t, _, _, ArgTypes, RetType}}} = get_call_type(TypedAst),
ArgVMTypes = [ aeso_ast_to_icode:ast_typerep(T, Icode) || T <- ArgTypes ],
RetVMType = case RetType of
{id, _, "_"} -> any;
_ -> aeso_ast_to_icode:ast_typerep(RetType, Icode)
end,
#{ functions := Funs } = Icode,
ArgIcode = get_arg_icode(Funs),
ArgTerms = [ icode_to_term(T, Arg) ||
{T, Arg} <- lists:zip(ArgVMTypes, ArgIcode) ],
RetVMType1 =
case FunName of
"init" -> {tuple, [typerep, RetVMType]};
_ -> RetVMType
end,
{ok, FunName, {ArgVMTypes, RetVMType1}, ArgTerms};
fate ->
%% First check the contract without the __call function
#{fcode := OrgFcode} = string_to_code(ContractString0, Options),
FateCode = aeso_fcode_to_fate:compile(OrgFcode, []),
%% collect all hashes and compute the first name without hash collision to
SymbolHashes = maps:keys(aeb_fate_code:symbols(FateCode)),
CallName = first_none_match(?CALL_NAME, SymbolHashes,
lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)),
ContractString = insert_call_function(ContractString0, CallName, FunName, Args, Options),
#{fcode := Fcode} = string_to_code(ContractString, Options),
CallArgs = arguments_of_body(CallName, FunName, Fcode),
{ok, FunName, CallArgs}
end
catch
error:{parse_errors, Errors} ->
{error, join_errors("Parse errors", Errors, fun (E) -> E end)};
error:{type_errors, Errors} ->
{error, join_errors("Type errors", Errors, fun (E) -> E end)};
error:{badmatch, {error, missing_call_function}} ->
{error, join_errors("Type errors", ["missing __call function"],
fun (E) -> E end)};
throw:Error -> %Don't ask
{error, join_errors("Code errors", [Error],
fun (E) -> io_lib:format("~p", [E]) end)}
end.
arguments_of_body(CallName, _FunName, Fcode) ->
#{body := Body} = maps:get({entrypoint, list_to_binary(CallName)}, maps:get(functions, Fcode)),
{def, _FName, Args} = Body,
%% FName is either {entrypoint, list_to_binary(FunName)} or 'init'
[ aeso_fcode_to_fate:term_to_fate(A) || A <- Args ].
first_none_match(_CallName, _Hashes, []) ->
error(unable_to_find_unique_call_name);
first_none_match(CallName, Hashes, [Char|Chars]) ->
case not lists:member(aeb_fate_code:symbol_identifier(list_to_binary(CallName)), Hashes) of
true ->
CallName;
false ->
first_none_match(?CALL_NAME++[Char], Hashes, Chars)
end.
%% Add the __call function to a contract.
-spec insert_call_function(string(), string(), string(), [string()], options()) -> string().
insert_call_function(Code, Call, FunName, Args, Options) ->
Ast = parse(Code, Options),
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"stateful entrypoint ", Call, "() = ", FunName, "(", string:join(Args, ","), ")\n"
]).
-spec insert_init_function(string(), options()) -> string().
insert_init_function(Code, Options) ->
Ast = parse(Code, Options),
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "), "entrypoint init() = ()\n"
]).
last_contract_indent(Decls) ->
case lists:last(Decls) of
{_, _, _, [Decl | _]} -> aeso_syntax:get_ann(col, Decl, 1) - 1;
_ -> 0
end.
-spec to_sophia_value(string(), string(), ok | error | revert, aeb_aevm_data:data()) ->
{ok, aeso_syntax:expr()} | {error, term()}.
to_sophia_value(ContractString, Fun, ResType, Data) ->
to_sophia_value(ContractString, Fun, ResType, Data, [{backend, aevm}]).
-spec to_sophia_value(string(), string(), ok | error | revert, binary(), options()) ->
{ok, aeso_syntax:expr()} | {error, term()}.
to_sophia_value(_, _, error, Err, _Options) ->
{ok, {app, [], {id, [], "error"}, [{string, [], Err}]}};
to_sophia_value(_, _, revert, Data, Options) ->
case proplists:get_value(backend, Options, aevm) of
aevm ->
case aeb_heap:from_binary(string, Data) of
{ok, Err} -> {ok, {app, [], {id, [], "abort"}, [{string, [], Err}]}};
{error, _} = Err -> Err
end;
fate ->
Err = aeb_fate_encoding:deserialize(Data),
{ok, {app, [], {id, [], "abort"}, [{string, [], Err}]}}
end;
to_sophia_value(ContractString, FunName, ok, Data, Options0) ->
Options = [no_code | Options0],
try
Code = string_to_code(ContractString, Options),
#{ typed_ast := TypedAst, type_env := TypeEnv} = Code,
{ok, _, Type0} = get_decode_type(FunName, TypedAst),
Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
case proplists:get_value(backend, Options, aevm) of
aevm ->
Icode = maps:get(icode, Code),
VmType = aeso_ast_to_icode:ast_typerep(Type, Icode),
case aeb_heap:from_binary(VmType, Data) of
{ok, VmValue} ->
try
{ok, aeso_vm_decode:from_aevm(VmType, Type, VmValue)}
catch throw:cannot_translate_to_sophia ->
Type0Str = prettypr:format(aeso_pretty:type(Type0)),
{error, join_errors("Translation error", [lists:flatten(io_lib:format("Cannot translate VM value ~p\n of type ~p\n to Sophia type ~s\n",
[Data, VmType, Type0Str]))],
fun (E) -> E end)}
end;
{error, _Err} ->
{error, join_errors("Decode errors", [lists:flatten(io_lib:format("Failed to decode binary at type ~p", [VmType]))],
fun(E) -> E end)}
end;
fate ->
try
{ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))}
catch throw:cannot_translate_to_sophia ->
{error, join_errors("Translation error",
[lists:flatten(io_lib:format("Cannot translate fate value ~p\n of Sophia type ~s\n",
[aeb_fate_encoding:deserialize(Data), Type]))],
fun (E) -> E end)};
_:R ->
{error, iolist_to_binary(io_lib:format("Decode error ~p: ~p\n", [R, erlang:get_stacktrace()]))}
end
end
catch
error:{parse_errors, Errors} ->
{error, join_errors("Parse errors", Errors, fun (E) -> E end)};
error:{type_errors, Errors} ->
{error, join_errors("Type errors", Errors, fun (E) -> E end)};
error:{badmatch, {error, missing_function}} ->
{error, join_errors("Type errors", ["no function: '" ++ FunName ++ "'"],
fun (E) -> E end)};
throw:Error -> %Don't ask
{error, join_errors("Code errors", [Error],
fun (E) -> io_lib:format("~p", [E]) end)}
end.
-spec create_calldata(string(), string(), [string()]) ->
{ok, binary(), aeb_aevm_data:type(), aeb_aevm_data:type()}
| {error, term()}.
create_calldata(Code, Fun, Args) ->
create_calldata(Code, Fun, Args, [{backend, aevm}]).
-spec create_calldata(string(), string(), [string()], [{atom(), any()}]) ->
{ok, binary()}
| {error, term()}.
create_calldata(Code, Fun, Args, Options0) ->
Options = [no_code | Options0],
case proplists:get_value(backend, Options, aevm) of
aevm ->
case check_call(Code, Fun, Args, Options) of
{ok, FunName, {ArgTypes, RetType}, VMArgs} ->
aeb_aevm_abi:create_calldata(FunName, VMArgs, ArgTypes, RetType);
{error, _} = Err -> Err
end;
fate ->
case check_call(Code, Fun, Args, Options) of
{ok, FunName, FateArgs} ->
aeb_fate_abi:create_calldata(FunName, FateArgs);
{error, _} = Err -> Err
end
end.
-spec decode_calldata(string(), string(), binary()) ->
{ok, [aeso_syntax:type()], [aeso_syntax:expr()]}
| {error, term()}.
decode_calldata(ContractString, FunName, Calldata) ->
decode_calldata(ContractString, FunName, Calldata, [{backend, aevm}]).
decode_calldata(ContractString, FunName, Calldata, Options0) ->
Options = [no_code | Options0],
try
Code = string_to_code(ContractString, Options),
#{ typed_ast := TypedAst, type_env := TypeEnv} = Code,
{ok, Args, _} = get_decode_type(FunName, TypedAst),
DropArg = fun({arg, _, _, T}) -> T; (T) -> T end,
ArgTypes = lists:map(DropArg, Args),
Type0 = {tuple_t, [], ArgTypes},
%% user defined data types such as variants needed to match against
Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
case proplists:get_value(backend, Options, aevm) of
aevm ->
Icode = maps:get(icode, Code),
VmType = aeso_ast_to_icode:ast_typerep(Type, Icode),
case aeb_heap:from_binary({tuple, [word, VmType]}, Calldata) of
{ok, {_, VmValue}} ->
try
{tuple, [], Values} = aeso_vm_decode:from_aevm(VmType, Type, VmValue),
%% Values are Sophia expressions in AST format
{ok, ArgTypes, Values}
catch throw:cannot_translate_to_sophia ->
Type0Str = prettypr:format(aeso_pretty:type(Type0)),
{error, join_errors("Translation error",
[lists:flatten(io_lib:format("Cannot translate VM value ~p\n of type ~p\n to Sophia type ~s\n",
[VmValue, VmType, Type0Str]))],
fun (E) -> E end)}
end;
{error, _Err} ->
{error, join_errors("Decode errors", [lists:flatten(io_lib:format("Failed to decode binary at type ~p", [VmType]))],
fun(E) -> E end)}
end;
fate ->
case aeb_fate_abi:decode_calldata(FunName, Calldata) of
{ok, FateArgs} ->
try
{tuple_t, [], ArgTypes1} = Type,
AstArgs = [ aeso_vm_decode:from_fate(ArgType, FateArg)
|| {ArgType, FateArg} <- lists:zip(ArgTypes1, FateArgs)],
{ok, ArgTypes, AstArgs}
catch throw:cannot_translate_to_sophia ->
Type0Str = prettypr:format(aeso_pretty:type(Type0)),
{error, join_errors("Translation error",
[lists:flatten(io_lib:format("Cannot translate fate value ~p\n of Sophia type ~s\n",
[FateArgs, Type0Str]))],
fun (E) -> E end)}
end;
{error, _} ->
{error, join_errors("Decode errors", ["Failed to decode binary"],
fun(E) -> E end)}
end
end
catch
error:{parse_errors, Errors} ->
{error, join_errors("Parse errors", Errors, fun (E) -> E end)};
error:{type_errors, Errors} ->
{error, join_errors("Type errors", Errors, fun (E) -> E end)};
error:{badmatch, {error, missing_function}} ->
{error, join_errors("Type errors", ["no function: '" ++ FunName ++ "'"],
fun (E) -> E end)};
throw:Error -> %Don't ask
{error, join_errors("Code errors", [Error],
fun (E) -> io_lib:format("~p", [E]) end)}
end.
get_arg_icode(Funs) ->
case [ Args || {[_, ?CALL_NAME], _, _, {funcall, _, Args}, _} <- Funs ] of
[Args] -> Args;
[] -> error({missing_call_function, Funs})
end.
get_call_type([{contract, _, _, Defs}]) ->
case [ {lists:last(QFunName), FunType}
|| {letfun, _, {id, _, ?CALL_NAME}, [], _Ret,
{typed, _,
{app, _,
{typed, _, {qid, _, QFunName}, FunType}, _}, _}} <- Defs ] of
[Call] -> {ok, Call};
[] -> {error, missing_call_function}
end;
get_call_type([_ | Contracts]) ->
%% The __call should be in the final contract
get_call_type(Contracts).
get_decode_type(FunName, [{contract, _, _, Defs}]) ->
GetType = fun({letfun, _, {id, _, Name}, Args, Ret, _}) when Name == FunName -> [{Args, Ret}];
({fun_decl, _, {id, _, Name}, {fun_t, _, _, Args, Ret}}) when Name == FunName -> [{Args, Ret}];
(_) -> [] end,
case lists:flatmap(GetType, Defs) of
[{Args, Ret}] -> {ok, Args, Ret};
[] ->
case FunName of
"init" -> {ok, [], {tuple_t, [], []}};
_ -> {error, missing_function}
end
end;
get_decode_type(FunName, [_ | Contracts]) ->
%% The __decode should be in the final contract
get_decode_type(FunName, Contracts).
%% Translate an icode value (error if not value) to an Erlang term that can be
%% consumed by aeb_heap:to_binary().
icode_to_term(word, {integer, N}) -> N;
icode_to_term(word, {unop, '-', {integer, N}}) -> -N;
icode_to_term(string, {tuple, [{integer, Len} | Words]}) ->
<<Str:Len/binary, _/binary>> = << <<W:256>> || {integer, W} <- Words >>,
Str;
icode_to_term({list, T}, {list, Vs}) ->
[ icode_to_term(T, V) || V <- Vs ];
icode_to_term({tuple, Ts}, {tuple, Vs}) ->
list_to_tuple(icodes_to_terms(Ts, Vs));
icode_to_term({variant, Cs}, {tuple, [{integer, Tag} | Args]}) ->
Ts = lists:nth(Tag + 1, Cs),
{variant, Tag, icodes_to_terms(Ts, Args)};
icode_to_term(T = {map, KT, VT}, M) ->
%% Maps are compiled to builtin and primop calls, so this gets a little hairy
case M of
{funcall, {var_ref, {builtin, map_put}}, [M1, K, V]} ->
Map = icode_to_term(T, M1),
Key = icode_to_term(KT, K),
Val = icode_to_term(VT, V),
Map#{ Key => Val };
#prim_call_contract{ address = {integer, 0},
arg = {tuple, [{integer, ?PRIM_CALL_MAP_EMPTY}, _, _]} } ->
#{};
_ -> throw({todo, M})
end;
icode_to_term(typerep, _) ->
throw({todo, typerep});
icode_to_term(T, V) ->
throw({not_a_value, T, V}).
icodes_to_terms(Ts, Vs) ->
[ icode_to_term(T, V) || {T, V} <- lists:zip(Ts, Vs) ].
ast_to_icode(TypedAst, Options) ->
aeso_ast_to_icode:convert_typed(TypedAst, Options).
assemble(Icode, Options) ->
aeso_icode_to_asm:convert(Icode, Options).
to_bytecode(['COMMENT',_|Rest],_Options) ->
to_bytecode(Rest,_Options);
to_bytecode([Op|Rest], Options) ->
[aeb_opcodes:m_to_op(Op)|to_bytecode(Rest, Options)];
to_bytecode([], _) -> [].
extract_type_info(#{functions := Functions} =_Icode) ->
ArgTypesOnly = fun(As) -> [ T || {_, T} <- As ] end,
Payable = fun(Attrs) -> proplists:get_value(payable, Attrs, false) end,
TypeInfo = [aeb_aevm_abi:function_type_info(list_to_binary(lists:last(Name)),
Payable(Attrs), ArgTypesOnly(Args), TypeRep)
|| {Name, Attrs, Args,_Body, TypeRep} <- Functions,
not is_tuple(Name),
not lists:member(private, Attrs)
],
lists:sort(TypeInfo).
pp_sophia_code(C, Opts)-> pp(C, Opts, pp_sophia_code, fun(Code) ->
io:format("~s\n", [prettypr:format(aeso_pretty:decls(Code))])
end).
pp_ast(C, Opts) -> pp(C, Opts, pp_ast, fun aeso_ast:pp/1).
pp_typed_ast(C, Opts)-> pp(C, Opts, pp_typed_ast, fun aeso_ast:pp_typed/1).
pp_icode(C, Opts) -> pp(C, Opts, pp_icode, fun aeso_icode:pp/1).
pp_assembler(C, Opts)-> pp(C, Opts, pp_assembler, fun aeb_asm:pp/1).
pp_bytecode(C, Opts) -> pp(C, Opts, pp_bytecode, fun aeb_disassemble:pp/1).
pp(Code, Options, Option, PPFun) ->
case proplists:lookup(Option, Options) of
{Option, true} ->
PPFun(Code);
none ->
ok
end.
%% -------------------------------------------------------------------
sophia_type_to_typerep(String) ->
{ok, Ast} = aeso_parser:type(String),
try aeso_ast_to_icode:ast_typerep(Ast) of
Type -> {ok, Type}
catch _:_ -> {error, bad_type}
end.
-spec parse(string(), aeso_compiler:options()) -> none() | aeso_syntax:ast().
parse(Text, Options) ->
parse(Text, sets:new(), Options).
-spec parse(string(), sets:set(), aeso_compiler:options()) -> none() | aeso_syntax:ast().
parse(Text, Included, Options) ->
%% Try and return something sensible here!
case aeso_parser:string(Text, Included, Options) of
%% Yay, it worked!
{ok, Contract} -> Contract;
%% Scan errors.
{error, {Pos, scan_error}} ->
parse_error(Pos, "scan error");
{error, {Pos, scan_error_no_state}} ->
parse_error(Pos, "scan error");
%% Parse errors.
{error, {Pos, parse_error, Error}} ->
parse_error(Pos, Error);
{error, {Pos, ambiguous_parse, As}} ->
ErrorString = io_lib:format("Ambiguous ~p", [As]),
parse_error(Pos, ErrorString);
%% Include error
{error, {Pos, include_error, File}} ->
parse_error(Pos, io_lib:format("could not find include file '~s'", [File]))
end.
-spec parse_error(aeso_parse_lib:pos(), string()) -> none().
parse_error(Pos, ErrorString) ->
Error = io_lib:format("~s: ~s", [pos_error(Pos), ErrorString]),
error({parse_errors, [Error]}).
read_contract(Name) ->
file:read_file(Name).
pos_error({Line, Pos}) ->
io_lib:format("line ~p, column ~p", [Line, Pos]);
pos_error({no_file, Line, Pos}) ->
pos_error({Line, Pos});
pos_error({File, Line, Pos}) ->
io_lib:format("file ~s, line ~p, column ~p", [File, Line, Pos]).

42
src/aeso_constants.erl Normal file
View File

@ -0,0 +1,42 @@
-module(aeso_constants).
-export([string/1, get_type/1]).
string(Str) ->
case aeso_parser:string("let _ = " ++ Str) of
{ok, [{letval, _, _, _, E}]} -> {ok, E};
{ok, Other} -> error({internal_error, should_be_letval, Other});
Err -> Err
end.
get_type(Str) ->
case aeso_parser:string("let _ = " ++ Str) of
{ok, [Ast]} ->
AstT = aeso_ast_infer_types:infer_constant(Ast),
T = ast_to_type(AstT),
{ok, T};
{ok, Other} -> error({internal_error, should_be_letval, Other});
Err -> Err
end.
ast_to_type({id, _, T}) ->
T;
ast_to_type({tuple_t, _, []}) -> "()";
ast_to_type({tuple_t, _, Ts}) ->
"(" ++ list_ast_to_type(Ts) ++ ")";
ast_to_type({app_t,_, {id, _, "list"}, [T]}) ->
lists:flatten("list(" ++ ast_to_type(T) ++ ")");
ast_to_type({app_t,_, {id, _, "option"}, [T]}) ->
lists:flatten("option(" ++ ast_to_type(T) ++ ")").
list_ast_to_type([T]) ->
ast_to_type(T);
list_ast_to_type([T|Ts]) ->
ast_to_type(T)
++ ", "
++ list_ast_to_type(Ts).

1576
src/aeso_fcode_to_fate.erl Normal file

File diff suppressed because it is too large Load Diff

143
src/aeso_icode.erl Normal file
View File

@ -0,0 +1,143 @@
%%%-------------------------------------------------------------------
%%% @author Happi (Erik Stenman)
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc
%%% Intermediate Code for Aeterinty Sophia language.
%%% @end
%%% Created : 21 Dec 2017
%%%
%%%-------------------------------------------------------------------
-module(aeso_icode).
-export([new/1,
pp/1,
set_name/2,
set_namespace/2,
set_payable/2,
enter_namespace/2,
get_namespace/1,
qualify/2,
set_functions/2,
map_typerep/2,
option_typerep/1,
get_constructor_tag/2]).
-export_type([icode/0]).
-include("aeso_icode.hrl").
-type type_def() :: fun(([aeb_aevm_data:type()]) -> aeb_aevm_data:type()).
-type bindings() :: any().
-type fun_dec() :: { string()
, [modifier()]
, arg_list()
, expr()
, aeb_aevm_data:type()}.
-type modifier() :: private | stateful.
-type type_name() :: string() | [string()].
-type icode() :: #{ contract_name => string()
, functions => [fun_dec()]
, namespace => aeso_syntax:con() | aeso_syntax:qcon()
, env => [bindings()]
, state_type => aeb_aevm_data:type()
, event_type => aeb_aevm_data:type()
, types => #{ type_name() => type_def() }
, type_vars => #{ string() => aeb_aevm_data:type() }
, constructors => #{ [string()] => integer() } %% name to tag
, options => [any()]
, payable => boolean()
}.
pp(Icode) ->
%% TODO: Actually do *Pretty* printing.
io:format("~p~n", [Icode]).
-spec new([any()]) -> icode().
new(Options) ->
#{ contract_name => ""
, functions => []
, env => new_env()
%% Default to unit type for state and event
, state_type => {tuple, []}
, event_type => {tuple, []}
, types => builtin_types()
, type_vars => #{}
, constructors => builtin_constructors()
, options => Options
, payable => false }.
builtin_types() ->
Word = fun([]) -> word end,
#{ "bool" => Word
, "int" => Word
, "bits" => Word
, "string" => fun([]) -> string end
, "address" => Word
, "hash" => Word
, "unit" => fun([]) -> {tuple, []} end
, "signature" => fun([]) -> {tuple, [word, word]} end
, "oracle" => fun([_, _]) -> word end
, "oracle_query" => fun([_, _]) -> word end
, "list" => fun([A]) -> {list, A} end
, "option" => fun([A]) -> {variant, [[], [A]]} end
, "map" => fun([K, V]) -> map_typerep(K, V) end
, ["Chain", "ttl"] => fun([]) -> {variant, [[word], [word]]} end
}.
builtin_constructors() ->
#{ ["RelativeTTL"] => 0
, ["FixedTTL"] => 1
, ["None"] => 0
, ["Some"] => 1 }.
map_typerep(K, V) ->
{map, K, V}.
option_typerep(A) ->
{variant, [[], [A]]}.
new_env() ->
[].
-spec set_name(string(), icode()) -> icode().
set_name(Name, Icode) ->
maps:put(contract_name, Name, Icode).
-spec set_payable(boolean(), icode()) -> icode().
set_payable(Payable, Icode) ->
maps:put(payable, Payable, Icode).
-spec set_namespace(aeso_syntax:con() | aeso_syntax:qcon(), icode()) -> icode().
set_namespace(NS, Icode) -> Icode#{ namespace => NS }.
-spec enter_namespace(aeso_syntax:con(), icode()) -> icode().
enter_namespace(NS, Icode = #{ namespace := NS1 }) ->
Icode#{ namespace => aeso_syntax:qualify(NS1, NS) };
enter_namespace(NS, Icode) ->
Icode#{ namespace => NS }.
-spec get_namespace(icode()) -> false | aeso_syntax:con() | aeso_syntax:qcon().
get_namespace(Icode) -> maps:get(namespace, Icode, false).
-spec qualify(aeso_syntax:id() | aeso_syntax:con(), icode()) -> aeso_syntax:id() | aeso_syntax:qid() | aeso_syntax:con() | aeso_syntax:qcon().
qualify(X, Icode) ->
case get_namespace(Icode) of
false -> X;
NS -> aeso_syntax:qualify(NS, X)
end.
-spec set_functions([fun_dec()], icode()) -> icode().
set_functions(NewFuns, Icode) ->
maps:put(functions, NewFuns, Icode).
-spec get_constructor_tag([string()], icode()) -> integer().
get_constructor_tag(Name, #{constructors := Constructors}) ->
case maps:get(Name, Constructors, undefined) of
undefined -> error({undefined_constructor, Name});
Tag -> Tag
end.

59
src/aeso_icode.hrl Normal file
View File

@ -0,0 +1,59 @@
-include_lib("aebytecode/include/aeb_typerep_def.hrl").
-record(arg, {name::string(), type::?Type()}).
-type expr() :: term().
-type arg() :: #arg{name::string(), type::?Type()}.
-type arg_list() :: [arg()].
-record(fun_dec, { name :: string()
, args :: arg_list()
, body :: expr()}).
-record(var_ref, { name :: string() | list(string()) | {builtin, atom() | tuple()}}).
-record(prim_call_contract,
{ gas :: expr()
, address :: expr()
, value :: expr()
, arg :: expr()
, type_hash:: expr()
}).
-record(prim_balance, { address :: expr() }).
-record(prim_block_hash, { height :: expr() }).
-record(prim_put, { state :: expr() }).
-record(integer, {value :: integer()}).
-record(tuple, {cpts :: [expr()]}).
-record(list, {elems :: [expr()]}).
-record(unop, { op :: term()
, rand :: expr()}).
-record(binop, { op :: term()
, left :: expr()
, right :: expr()}).
-record(ifte, { decision :: expr()
, then :: expr()
, else :: expr()}).
-record(switch, { expr :: expr()
, cases :: [{expr(),expr()}]}).
-record(funcall, { function :: expr()
, args :: [expr()]}).
-record(lambda, { args :: arg_list(),
body :: expr()}).
-record(missing_field, { format :: string()
, args :: [term()]}).
-record(seq, {exprs :: [expr()]}).
-record(event, {topics :: [expr()], payload :: expr()}).

983
src/aeso_icode_to_asm.erl Normal file
View File

@ -0,0 +1,983 @@
%%%-------------------------------------------------------------------
%%% @author Happi (Erik Stenman)
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc
%%% Translator from Aesophia Icode to Aevm Assebly
%%% @end
%%% Created : 21 Dec 2017
%%%
%%%-------------------------------------------------------------------
-module(aeso_icode_to_asm).
-export([convert/2]).
-include_lib("aebytecode/include/aeb_opcodes.hrl").
-include("aeso_icode.hrl").
i(Code) -> aeb_opcodes:mnemonic(Code).
%% We don't track purity or statefulness in the type checker yet.
is_stateful({FName, _, _, _, _}) -> lists:last(FName) /= "init".
is_public({_Name, Attrs, _Args, _Body, _Type}) -> not lists:member(private, Attrs).
convert(#{ contract_name := _ContractName
, state_type := StateType
, functions := Functions
},
_Options) ->
%% Create a function dispatcher
DispatchFun = {"_main", [], [{"arg", "_"}],
{switch, {var_ref, "arg"},
[{{tuple, [fun_hash(Fun),
{tuple, make_args(Args)}]},
icode_seq([ hack_return_address(Fun, length(Args) + 1) ] ++
[ {funcall, {var_ref, FName}, make_args(Args)}]
)}
|| Fun={FName, _, Args, _,_TypeRep} <- Functions, is_public(Fun) ]},
word},
NewFunctions = Functions ++ [DispatchFun],
%% Create a function environment
Funs = [{Name, length(Args), make_ref()}
|| {Name, _Attrs, Args, _Body, _Type} <- NewFunctions],
%% Create dummy code to call the main function with one argument
%% taken from the stack
StopLabel = make_ref(),
StatefulStopLabel = make_ref(),
MainFunction = lookup_fun(Funs, "_main"),
StateTypeValue = aeso_ast_to_icode:type_value(StateType),
DispatchCode = [%% push two return addresses to stop, one for stateful
%% functions and one for non-stateful functions.
push_label(StatefulStopLabel),
push_label(StopLabel),
%% The calldata is already on the stack when we start. Put
%% it on top (also reorders StatefulStop and Stop).
swap(2),
jump(MainFunction),
jumpdest(StatefulStopLabel),
%% We need to encode the state type and put it
%% underneath the return value.
assemble_expr(Funs, [], nontail, StateTypeValue), %% StateT Ret
swap(1), %% Ret StateT
%% We should also change the state value at address 0 to a
%% pointer to the state value (to allow 0 to represent an
%% unchanged state).
i(?MSIZE), %% Ptr
push(0), i(?MLOAD), %% Val Ptr
i(?MSIZE), i(?MSTORE), %% Ptr Mem[Ptr] := Val
push(0), i(?MSTORE), %% Mem[0] := Ptr
%% The pointer to the return value is on top of
%% the stack, but the return instruction takes two
%% stack arguments.
push(0),
i(?RETURN),
jumpdest(StopLabel),
%% Set state pointer to 0 to indicate that we didn't change state
push(0), dup(1), i(?MSTORE),
%% Same as StatefulStopLabel above
push(0),
i(?RETURN)
],
%% Code is a deep list of instructions, containing labels and
%% references to them. Labels take the form {'JUMPDEST', Ref}, and
%% references take the form {push_label, Ref}, which is translated
%% into a PUSH instruction.
Code = [assemble_function(Funs, Name, Args, Body)
|| {Name, _, Args, Body, _Type} <- NewFunctions],
resolve_references(
[%% i(?COMMENT), "CONTRACT: " ++ ContractName,
DispatchCode,
Code]).
%% Generate error on correct format.
gen_error(Error) ->
error({code_errors, [Error]}).
make_args(Args) ->
[{var_ref, [I-1 + $a]} || I <- lists:seq(1, length(Args))].
fun_hash({FName, _, Args, _, TypeRep}) ->
ArgType = {tuple, [T || {_, T} <- Args]},
<<Hash:256>> = aeb_aevm_abi:function_type_hash(list_to_binary(lists:last(FName)), ArgType, TypeRep),
{integer, Hash}.
%% Expects two return addresses below N elements on the stack. Picks the top
%% one for stateful functions and the bottom one for non-stateful.
hack_return_address(Fun, N) ->
case is_stateful(Fun) of
true -> {inline_asm, [i(?MSIZE)]};
false ->
{inline_asm, %% X1 .. XN State NoState
[ dup(N + 2) %% NoState X1 .. XN State NoState
, swap(N + 1) %% State X1 .. XN NoState NoState
]} %% Top of the stack will be discarded.
end.
assemble_function(Funs, Name, Args, Body) ->
[jumpdest(lookup_fun(Funs, Name)),
assemble_expr(Funs, lists:reverse(Args), tail, Body),
%% swap return value and first argument
pop_args(length(Args)),
swap(1),
i(?JUMP)].
%% {seq, Es} - should be "one" operation in terms of stack content
%% i.e. after the `seq` there should be one new element on the stack.
assemble_expr(Funs, Stack, Tail, {seq, [E]}) ->
assemble_expr(Funs, Stack, Tail, E);
assemble_expr(Funs, Stack, Tail, {seq, [E | Es]}) ->
[assemble_expr(Funs, Stack, nontail, E),
assemble_expr(Funs, Stack, Tail, {seq, Es})];
assemble_expr(_Funs, _Stack, _Tail, {inline_asm, Code}) ->
Code; %% Unsafe! Code should take care to respect the stack!
assemble_expr(Funs, Stack, _TailPosition, {var_ref, Id}) ->
case lists:keymember(Id, 1, Stack) of
true ->
dup(lookup_var(Id, Stack));
false ->
%% Build a closure
%% When a top-level fun is called directly, we do not
%% reach this case.
Eta = make_ref(),
Continue = make_ref(),
[i(?MSIZE),
push_label(Eta),
dup(2),
i(?MSTORE),
jump(Continue),
%% the code of the closure
jumpdest(Eta),
%% pop the pointer to the function
pop(1),
jump(lookup_fun(Funs, Id)),
jumpdest(Continue)]
end;
assemble_expr(_, _, _, {missing_field, Format, Args}) ->
io:format(Format, Args),
gen_error(missing_field);
assemble_expr(_Funs, _Stack, _, {integer, N}) ->
push(N);
assemble_expr(Funs, Stack, _, {tuple, Cpts}) ->
%% We build tuples right-to-left, so that the first write to the
%% tuple extends the memory size. Because we use ?MSIZE as the
%% heap pointer, we must allocate the tuple AFTER computing the
%% first element.
%% We store elements into the tuple as soon as possible, to avoid
%% keeping them for a long time on the stack.
case lists:reverse(Cpts) of
[] ->
i(?MSIZE);
[Last|Rest] ->
[assemble_expr(Funs, Stack, nontail, Last),
%% allocate the tuple memory
i(?MSIZE),
%% compute address of last word
push(32 * (length(Cpts) - 1)), i(?ADD),
%% Stack: <last-value> <pointer>
%% Write value to memory (allocates the tuple)
swap(1), dup(2), i(?MSTORE),
%% Stack: pointer to last word written
[[%% Update pointer to next word to be written
push(32), swap(1), i(?SUB),
%% Compute element
assemble_expr(Funs, [pointer|Stack], nontail, A),
%% Write element to memory
dup(2), i(?MSTORE)]
%% And we leave a pointer to the last word written on
%% the stack
|| A <- Rest]]
%% The pointer to the entire tuple is on the stack
end;
assemble_expr(_Funs, _Stack, _, {list, []}) ->
%% Use Erik's value of -1 for []
[push(0), i(?NOT)];
assemble_expr(Funs, Stack, _, {list, [A|B]}) ->
assemble_expr(Funs, Stack, nontail, {tuple, [A, {list, B}]});
assemble_expr(Funs, Stack, _, {unop, '!', A}) ->
case A of
{binop, Logical, _, _} when Logical=='&&'; Logical=='||' ->
assemble_expr(Funs, Stack, nontail, {ifte, A, {integer, 0}, {integer, 1}});
_ ->
[assemble_expr(Funs, Stack, nontail, A),
i(?ISZERO)
]
end;
assemble_expr(Funs, Stack, _, {event, Topics, Payload}) ->
[assemble_exprs(Funs, Stack, Topics ++ [Payload]),
case length(Topics) of
0 -> i(?LOG0);
1 -> i(?LOG1);
2 -> i(?LOG2);
3 -> i(?LOG3);
4 -> i(?LOG4)
end, i(?MSIZE)];
assemble_expr(Funs, Stack, _, {unop, Op, A}) ->
[assemble_expr(Funs, Stack, nontail, A),
assemble_prefix(Op)];
assemble_expr(Funs, Stack, Tail, {binop, '&&', A, B}) ->
assemble_expr(Funs, Stack, Tail, {ifte, A, B, {integer, 0}});
assemble_expr(Funs, Stack, Tail, {binop, '||', A, B}) ->
assemble_expr(Funs, Stack, Tail, {ifte, A, {integer, 1}, B});
assemble_expr(Funs, Stack, Tail, {binop, '::', A, B}) ->
%% Take advantage of optimizations in tuple construction.
assemble_expr(Funs, Stack, Tail, {tuple, [A, B]});
assemble_expr(Funs, Stack, _, {binop, Op, A, B}) ->
%% EEVM binary instructions take their first argument from the top
%% of the stack, so to get operands on the stack in the right
%% order, we evaluate from right to left.
[assemble_expr(Funs, Stack, nontail, B),
assemble_expr(Funs, [dummy|Stack], nontail, A),
assemble_infix(Op)];
assemble_expr(Funs, Stack, _, {lambda, Args, Body}) ->
Function = make_ref(),
FunBody = make_ref(),
Continue = make_ref(),
NoMatch = make_ref(),
FreeVars = free_vars({lambda, Args, Body}),
{NewVars, MatchingCode} = assemble_pattern(FunBody, NoMatch, {tuple, [{var_ref, "_"}|FreeVars]}),
BodyCode = assemble_expr(Funs, NewVars ++ lists:reverse([ {Arg#arg.name, Arg#arg.type} || Arg <- Args ]), tail, Body),
[assemble_expr(Funs, Stack, nontail, {tuple, [{label, Function}|FreeVars]}),
jump(Continue), %% will be optimized away
jumpdest(Function),
%% A pointer to the closure is on the stack
MatchingCode,
jumpdest(FunBody),
BodyCode,
pop_args(length(Args)+length(NewVars)),
swap(1),
i(?JUMP),
jumpdest(NoMatch), %% dead code--raise an exception just in case
push(0),
i(?NOT),
i(?MLOAD),
i(?STOP),
jumpdest(Continue)];
assemble_expr(_, _, _, {label, Label}) ->
push_label(Label);
assemble_expr(Funs, Stack, nontail, {funcall, Fun, Args}) ->
Return = make_ref(),
%% This is the obvious code:
%% [{push_label, Return},
%% assemble_exprs(Funs, [return_address|Stack], Args++[Fun]),
%% 'JUMP',
%% {'JUMPDEST', Return}];
%% Its problem is that it stores the return address on the stack
%% while the arguments are computed, which is unnecessary. To
%% avoid that, we compute the last argument FIRST, and replace it
%% with the return address using a SWAP.
%%
%% assemble_function leaves the code pointer of the function to
%% call on top of the stack, and--if the function is not a
%% top-level name--a pointer to its tuple of free variables. In
%% either case a JUMP is the right way to call it.
case Args of
[] ->
[push_label(Return),
assemble_function(Funs, [return_address|Stack], Fun),
i(?JUMP),
jumpdest(Return)];
_ ->
{Init, [Last]} = lists:split(length(Args) - 1, Args),
[assemble_exprs(Funs, Stack, [Last|Init]),
%% Put the return address in the right place, which also
%% reorders the args correctly.
push_label(Return),
swap(length(Args)),
assemble_function(Funs, [dummy || _ <- Args] ++ [return_address|Stack], Fun),
i(?JUMP),
jumpdest(Return)]
end;
assemble_expr(Funs, Stack, tail, {funcall, Fun, Args}) ->
IsTopLevel = is_top_level_fun(Stack, Fun),
%% If the fun is not top-level, then it may refer to local
%% variables and must be computed before stack shuffling.
ArgsAndFun = Args++[Fun || not IsTopLevel],
ComputeArgsAndFun = assemble_exprs(Funs, Stack, ArgsAndFun),
%% Copy arguments back down the stack to the start of the frame
ShuffleSpec = lists:seq(length(ArgsAndFun), 1, -1) ++ [discard || _ <- Stack],
Shuffle = shuffle_stack(ShuffleSpec),
[ComputeArgsAndFun, Shuffle,
if IsTopLevel ->
%% still need to compute function
assemble_function(Funs, [], Fun);
true ->
%% need to unpack a closure
[dup(1), i(?MLOAD)]
end,
i(?JUMP)];
assemble_expr(Funs, Stack, Tail, {ifte, Decision, Then, Else}) ->
%% This compilation scheme introduces a lot of labels and
%% jumps. Unnecessary ones are removed later in
%% resolve_references.
Close = make_ref(),
ThenL = make_ref(),
ElseL = make_ref(),
[assemble_decision(Funs, Stack, Decision, ThenL, ElseL),
jumpdest(ElseL),
assemble_expr(Funs, Stack, Tail, Else),
jump(Close),
jumpdest(ThenL),
assemble_expr(Funs, Stack, Tail, Then),
jumpdest(Close)
];
assemble_expr(Funs, Stack, Tail, {switch, A, Cases}) ->
Close = make_ref(),
[assemble_expr(Funs, Stack, nontail, A),
assemble_cases(Funs, Stack, Tail, Close, Cases),
{'JUMPDEST', Close}];
%% State primitives
%% (A pointer to) the contract state is stored at address 0.
assemble_expr(_Funs, _Stack, _Tail, prim_state) ->
[push(0), i(?MLOAD)];
assemble_expr(Funs, Stack, _Tail, #prim_put{ state = State }) ->
[assemble_expr(Funs, Stack, nontail, State),
push(0), i(?MSTORE), %% We need something for the unit value on the stack,
i(?MSIZE)]; %% MSIZE is the cheapest instruction.
%% Environment primitives
assemble_expr(_Funs, _Stack, _Tail, prim_contract_address) ->
[i(?ADDRESS)];
assemble_expr(_Funs, _Stack, _Tail, prim_contract_creator) ->
[i(?CREATOR)];
assemble_expr(_Funs, _Stack, _Tail, prim_call_origin) ->
[i(?ORIGIN)];
assemble_expr(_Funs, _Stack, _Tail, prim_caller) ->
[i(?CALLER)];
assemble_expr(_Funs, _Stack, _Tail, prim_call_value) ->
[i(?CALLVALUE)];
assemble_expr(_Funs, _Stack, _Tail, prim_gas_price) ->
[i(?GASPRICE)];
assemble_expr(_Funs, _Stack, _Tail, prim_gas_left) ->
[i(?GAS)];
assemble_expr(_Funs, _Stack, _Tail, prim_coinbase) ->
[i(?COINBASE)];
assemble_expr(_Funs, _Stack, _Tail, prim_timestamp) ->
[i(?TIMESTAMP)];
assemble_expr(_Funs, _Stack, _Tail, prim_block_height) ->
[i(?NUMBER)];
assemble_expr(_Funs, _Stack, _Tail, prim_difficulty) ->
[i(?DIFFICULTY)];
assemble_expr(_Funs, _Stack, _Tail, prim_gas_limit) ->
[i(?GASLIMIT)];
assemble_expr(Funs, Stack, _Tail, #prim_balance{ address = Addr }) ->
[assemble_expr(Funs, Stack, nontail, Addr),
i(?BALANCE)];
assemble_expr(Funs, Stack, _Tail, #prim_block_hash{ height = Height }) ->
[assemble_expr(Funs, Stack, nontail, Height),
i(?BLOCKHASH)];
assemble_expr(Funs, Stack, _Tail,
#prim_call_contract{ gas = Gas
, address = To
, value = Value
, arg = Arg
, type_hash= TypeHash
}) ->
%% ?CALL takes (from the top)
%% Gas, To, Value, Arg, TypeHash, _OOffset,_OSize
%% So assemble these in reverse order.
[ assemble_exprs(Funs, Stack, [ {integer, 0}, {integer, 0}, TypeHash
, Arg, Value, To, Gas ])
, i(?CALL)
].
assemble_exprs(_Funs, _Stack, []) ->
[];
assemble_exprs(Funs, Stack, [E|Es]) ->
[assemble_expr(Funs, Stack, nontail, E),
assemble_exprs(Funs, [dummy|Stack], Es)].
assemble_decision(Funs, Stack, {binop, '&&', A, B}, Then, Else) ->
Label = make_ref(),
[assemble_decision(Funs, Stack, A, Label, Else),
jumpdest(Label),
assemble_decision(Funs, Stack, B, Then, Else)];
assemble_decision(Funs, Stack, {binop, '||', A, B}, Then, Else) ->
Label = make_ref(),
[assemble_decision(Funs, Stack, A, Then, Label),
jumpdest(Label),
assemble_decision(Funs, Stack, B, Then, Else)];
assemble_decision(Funs, Stack, {unop, '!', A}, Then, Else) ->
assemble_decision(Funs, Stack, A, Else, Then);
assemble_decision(Funs, Stack, {ifte, A, B, C}, Then, Else) ->
TrueL = make_ref(),
FalseL = make_ref(),
[assemble_decision(Funs, Stack, A, TrueL, FalseL),
jumpdest(TrueL), assemble_decision(Funs, Stack, B, Then, Else),
jumpdest(FalseL), assemble_decision(Funs, Stack, C, Then, Else)];
assemble_decision(Funs, Stack, Decision, Then, Else) ->
[assemble_expr(Funs, Stack, nontail, Decision),
jump_if(Then), jump(Else)].
%% Entered with value to switch on on top of the stack
%% Evaluate selected case, then jump to Close with result on the
%% stack.
assemble_cases(_Funs, _Stack, _Tail, _Close, []) ->
%% No match! What should be do? There's no real way to raise an
%% exception, except consuming all the gas.
%% There should not be enough gas to do this:
[push(1), i(?NOT),
i(?MLOAD),
%% now stop, so that jump optimizer realizes we will not fall
%% through this code.
i(?STOP)];
assemble_cases(Funs, Stack, Tail, Close, [{Pattern, Body}|Cases]) ->
Succeed = make_ref(),
Fail = make_ref(),
{NewVars, MatchingCode} =
assemble_pattern(Succeed, Fail, Pattern),
%% In the code that follows, if this is NOT the last case, then we
%% save the value being switched on, and discard it on
%% success. The code is simpler if this IS the last case.
[[dup(1) || Cases /= []], %% save value for next case, if there is one
MatchingCode,
jumpdest(Succeed),
%% Discard saved value, if we saved one
[case NewVars of
[] ->
pop(1);
[_] ->
%% Special case for peep-hole optimization
pop_args(1);
_ ->
[swap(length(NewVars)), pop(1)]
end
|| Cases/=[]],
assemble_expr(Funs,
case Cases of
[] -> NewVars;
_ -> reorder_vars(NewVars)
end
++Stack, Tail, Body),
%% If the Body makes a tail call, then we will not return
%% here--but it doesn't matter, because
%% (a) the NewVars will be popped before the tailcall
%% (b) the code below will be deleted since it is dead
pop_args(length(NewVars)),
jump(Close),
jumpdest(Fail),
assemble_cases(Funs, Stack, Tail, Close, Cases)].
%% Entered with value to match on top of the stack.
%% Generated code removes value, and
%% - jumps to Fail if no match, or
%% - binds variables, leaves them on the stack, and jumps to Succeed
%% Result is a list of variables to add to the stack, and the matching
%% code.
assemble_pattern(Succeed, Fail, {integer, N}) ->
{[], [push(N),
i(?EQ),
jump_if(Succeed),
jump(Fail)]};
assemble_pattern(Succeed, _Fail, {var_ref, "_"}) ->
{[], [i(?POP), jump(Succeed)]};
assemble_pattern(Succeed, Fail, {missing_field, _, _}) ->
%% Missing record fields are quite ok in patterns.
assemble_pattern(Succeed, Fail, {var_ref, "_"});
assemble_pattern(Succeed, _Fail, {var_ref, Id}) ->
{[{Id, "_"}], jump(Succeed)};
assemble_pattern(Succeed, _Fail, {tuple, []}) ->
{[], [pop(1), jump(Succeed)]};
assemble_pattern(Succeed, Fail, {tuple, [A]}) ->
%% Treat this case specially, because we don't need to save the
%% pointer to the tuple.
{AVars, ACode} = assemble_pattern(Succeed, Fail, A),
{AVars, [i(?MLOAD),
ACode]};
assemble_pattern(Succeed, Fail, {tuple, [A|B]}) ->
%% Entered with the address of the tuple on the top of the
%% stack. We will duplicate the address before matching on A.
Continue = make_ref(), %% the label for matching B
Pop1Fail = make_ref(), %% pop 1 word and goto Fail
PopNFail = make_ref(), %% pop length(AVars) words and goto Fail
{AVars, ACode} =
assemble_pattern(Continue, Pop1Fail, A),
{BVars, BCode} =
assemble_pattern(Succeed, PopNFail, {tuple, B}),
{BVars ++ reorder_vars(AVars),
[%% duplicate the pointer so we don't lose it when we match on A
dup(1),
i(?MLOAD),
ACode,
jumpdest(Continue),
%% Bring the pointer to the top of the stack--this reorders AVars!
swap(length(AVars)),
push(32),
i(?ADD),
BCode,
case AVars of
[] ->
[jumpdest(Pop1Fail), pop(1),
jumpdest(PopNFail),
jump(Fail)];
_ ->
[{'JUMPDEST', PopNFail}, pop(length(AVars)-1),
{'JUMPDEST', Pop1Fail}, pop(1),
{push_label, Fail}, 'JUMP']
end]};
assemble_pattern(Succeed, Fail, {list, []}) ->
%% [] is represented by -1.
{[], [push(1),
i(?ADD),
jump_if(Fail),
jump(Succeed)]};
assemble_pattern(Succeed, Fail, {list, [A|B]}) ->
assemble_pattern(Succeed, Fail, {binop, '::', A, {list, B}});
assemble_pattern(Succeed, Fail, {binop, '::', A, B}) ->
%% Make sure it's not [], then match as tuple.
NotNil = make_ref(),
{Vars, Code} = assemble_pattern(Succeed, Fail, {tuple, [A, B]}),
{Vars, [dup(1), push(1), i(?ADD), %% Check for [] without consuming the value
jump_if(NotNil), %% so it's still there when matching the tuple.
pop(1), %% It was [] so discard the saved value.
jump(Fail),
jumpdest(NotNil),
Code]}.
%% When Vars are on the stack, with a value we want to discard
%% below them, then we swap the top variable with that value and pop.
%% This reorders the variables on the stack, as follows:
reorder_vars([]) ->
[];
reorder_vars([V|Vs]) ->
Vs ++ [V].
assemble_prefix('sha3') -> [i(?DUP1), i(?MLOAD), %% length, ptr
i(?SWAP1), push(32), i(?ADD), %% ptr+32, length
i(?SHA3)];
assemble_prefix('-') -> [push(0), i(?SUB)];
assemble_prefix('bnot') -> i(?NOT).
assemble_infix('+') -> i(?ADD);
assemble_infix('-') -> i(?SUB);
assemble_infix('*') -> i(?MUL);
assemble_infix('/') -> i(?SDIV);
assemble_infix('div') -> i(?DIV);
assemble_infix('mod') -> i(?MOD);
assemble_infix('^') -> i(?EXP);
assemble_infix('bor') -> i(?OR);
assemble_infix('band') -> i(?AND);
assemble_infix('bxor') -> i(?XOR);
assemble_infix('bsl') -> i(?SHL);
assemble_infix('bsr') -> i(?SHR);
assemble_infix('<') -> i(?SLT); %% comparisons are SIGNED
assemble_infix('>') -> i(?SGT);
assemble_infix('==') -> i(?EQ);
assemble_infix('<=') -> [i(?SGT), i(?ISZERO)];
assemble_infix('=<') -> [i(?SGT), i(?ISZERO)];
assemble_infix('>=') -> [i(?SLT), i(?ISZERO)];
assemble_infix('!=') -> [i(?EQ), i(?ISZERO)];
assemble_infix('!') -> [i(?ADD), i(?MLOAD)];
assemble_infix('byte') -> i(?BYTE).
%% assemble_infix('::') -> [i(?MSIZE), write_word(0), write_word(1)].
%% a function may either refer to a top-level function, in which case
%% we fetch the code label from Funs, or it may be a lambda-expression
%% (including a top-level function passed as a parameter). In the
%% latter case, the function value is a pointer to a tuple of the code
%% pointer and the free variables: we keep the pointer and push the
%% code pointer onto the stack. In either case, we are ready to enter
%% the function with JUMP.
assemble_function(Funs, Stack, Fun) ->
case is_top_level_fun(Stack, Fun) of
true ->
{var_ref, Name} = Fun,
{push_label, lookup_fun(Funs, Name)};
false ->
[assemble_expr(Funs, Stack, nontail, Fun),
dup(1),
i(?MLOAD)]
end.
free_vars(V={var_ref, _}) ->
[V];
free_vars({switch, E, Cases}) ->
lists:umerge(free_vars(E),
lists:umerge([free_vars(Body)--free_vars(Pattern)
|| {Pattern, Body} <- Cases]));
free_vars({lambda, Args, Body}) ->
free_vars(Body) -- [{var_ref, Arg#arg.name} || Arg <- Args];
free_vars(T) when is_tuple(T) ->
free_vars(tuple_to_list(T));
free_vars([H|T]) ->
lists:umerge(free_vars(H), free_vars(T));
free_vars(_) ->
[].
%% shuffle_stack reorders the stack, for example before a tailcall. It is called
%% with a description of the current stack, and how the final stack
%% should appear. The argument is a list containing
%% a NUMBER for each element that should be kept, the number being
%% the position this element should occupy in the final stack
%% discard, for elements that can be discarded.
%% The positions start at 1, referring to the variable to be placed at
%% the bottom of the stack, and ranging up to the size of the final stack.
shuffle_stack([]) ->
[];
shuffle_stack([discard|Stack]) ->
[i(?POP) | shuffle_stack(Stack)];
shuffle_stack([N|Stack]) ->
case length(Stack) + 1 - N of
0 ->
%% the job should be finished
CorrectStack = lists:seq(N - 1, 1, -1),
CorrectStack = Stack,
[];
MoveBy ->
{Pref, [_|Suff]} = lists:split(MoveBy - 1, Stack),
[swap(MoveBy) | shuffle_stack([lists:nth(MoveBy, Stack) | Pref ++ [N|Suff]])]
end.
lookup_fun(Funs, Name) ->
case [Ref || {Name1, _, Ref} <- Funs,
Name == Name1] of
[Ref] -> Ref;
[] -> gen_error({undefined_function, Name})
end.
is_top_level_fun(Stack, {var_ref, Id}) ->
not lists:keymember(Id, 1, Stack);
is_top_level_fun(_, _) ->
false.
lookup_var(Id, Stack) ->
lookup_var(1, Id, Stack).
lookup_var(N, Id, [{Id, _Type}|_]) ->
N;
lookup_var(N, Id, [_|Stack]) ->
lookup_var(N + 1, Id, Stack);
lookup_var(_, Id, []) ->
gen_error({var_not_in_scope, Id}).
%% Smart instruction generation
%% TODO: handle references to the stack beyond depth 16. Perhaps the
%% best way is to repush variables that will be needed in
%% subexpressions before evaluating he subexpression... i.e. fix the
%% problem in assemble_expr, rather than here. A fix here would have
%% to save the top elements of the stack in memory, duplicate the
%% targetted element, and then repush the values from memory.
dup(N) when 1 =< N, N =< 16 ->
i(?DUP1 + N - 1).
push(N) ->
Bytes = binary:encode_unsigned(N),
true = size(Bytes) =< 32,
[i(?PUSH1 + size(Bytes) - 1) |
binary_to_list(Bytes)].
%% Pop N values from UNDER the top element of the stack.
%% This is a pseudo-instruction so peephole optimization can
%% combine pop_args(M), pop_args(N) to pop_args(M+N)
pop_args(0) ->
[];
pop_args(N) ->
{pop_args, N}.
%% [swap(N), pop(N)].
pop(N) ->
[i(?POP) || _ <- lists:seq(1, N)].
swap(0) ->
%% Doesn't exist, but is logically a no-op.
[];
swap(N) when 1 =< N, N =< 16 ->
i(?SWAP1 + N - 1).
jumpdest(Label) -> {i(?JUMPDEST), Label}.
push_label(Label) -> {push_label, Label}.
jump(Label) -> [push_label(Label), i(?JUMP)].
jump_if(Label) -> [push_label(Label), i(?JUMPI)].
%% ICode utilities (TODO: move to separate module)
icode_noname() -> #var_ref{name = "_"}.
icode_seq([A]) -> A;
icode_seq([A | As]) ->
icode_seq(A, icode_seq(As)).
icode_seq(A, B) ->
#switch{ expr = A, cases = [{icode_noname(), B}] }.
%% Stack: <N elements> ADDR
%% Write elements at addresses ADDR, ADDR+32, ADDR+64...
%% Stack afterwards: ADDR
% write_words(N) ->
% [write_word(I) || I <- lists:seq(N-1, 0, -1)].
%% Unused at the moment. Comment out to please dialyzer.
%% write_word(I) ->
%% [%% Stack: elements e ADDR
%% swap(1),
%% dup(2),
%% %% Stack: elements ADDR e ADDR
%% push(32*I),
%% i(?ADD),
%% %% Stack: elements ADDR e ADDR+32I
%% i(?MSTORE)].
%% Resolve references, and convert code from deep list to flat list.
%% List elements are:
%% Opcodes
%% Byte values
%% {'JUMPDEST', Ref} -- assembles to ?JUMPDEST and sets Ref
%% {push_label, Ref} -- assembles to ?PUSHN address bytes
%% For now, we assemble all code addresses as three bytes.
resolve_references(Code) ->
Peephole = peep_hole(lists:flatten(Code)),
%% WARNING: Optimizing jumps reorders the code and deletes
%% instructions. When debugging the assemble_ functions, it can be
%% useful to replace the next line by:
%% Instrs = lists:flatten(Code),
%% thus disabling the optimization.
OptimizedJumps = optimize_jumps(Peephole),
Instrs = lists:reverse(peep_hole_backwards(lists:reverse(OptimizedJumps))),
Labels = define_labels(0, Instrs),
lists:flatten([use_labels(Labels, I) || I <- Instrs]).
define_labels(Addr, [{'JUMPDEST', Lab}|More]) ->
[{Lab, Addr}|define_labels(Addr + 1, More)];
define_labels(Addr, [{push_label, _}|More]) ->
define_labels(Addr + 4, More);
define_labels(Addr, [{pop_args, N}|More]) ->
define_labels(Addr + N + 1, More);
define_labels(Addr, [_|More]) ->
define_labels(Addr + 1, More);
define_labels(_, []) ->
[].
use_labels(_, {'JUMPDEST', _}) ->
'JUMPDEST';
use_labels(Labels, {push_label, Ref}) ->
case proplists:get_value(Ref, Labels) of
undefined ->
gen_error({undefined_label, Ref});
Addr when is_integer(Addr) ->
[i(?PUSH3),
Addr div 65536, (Addr div 256) rem 256, Addr rem 256]
end;
use_labels(_, {pop_args, N}) ->
[swap(N), pop(N)];
use_labels(_, I) ->
I.
%% Peep-hole optimization.
%% The compilation of conditionals can introduce jumps depending on
%% constants 1 and 0. These are removed by peep-hole optimization.
peep_hole(['PUSH1', 0, {push_label, _}, 'JUMPI'|More]) ->
peep_hole(More);
peep_hole(['PUSH1', 1, {push_label, Lab}, 'JUMPI'|More]) ->
[{push_label, Lab}, 'JUMP'|peep_hole(More)];
peep_hole([{pop_args, M}, {pop_args, N}|More]) when M + N =< 16 ->
peep_hole([{pop_args, M + N}|More]);
peep_hole([I|More]) ->
[I|peep_hole(More)];
peep_hole([]) ->
[].
%% Peep-hole optimization on reversed instructions lists.
peep_hole_backwards(Code) ->
NewCode = peep_hole_backwards1(Code),
if Code == NewCode -> Code;
true -> peep_hole_backwards(NewCode)
end.
peep_hole_backwards1(['ADD', 0, 'PUSH1'|Code]) ->
peep_hole_backwards1(Code);
peep_hole_backwards1(['POP', UnOp|Code]) when UnOp=='MLOAD';UnOp=='ISZERO';UnOp=='NOT' ->
peep_hole_backwards1(['POP'|Code]);
peep_hole_backwards1(['POP', BinOp|Code]) when
%% TODO: more binary operators
BinOp=='ADD';BinOp=='SUB';BinOp=='MUL';BinOp=='SDIV' ->
peep_hole_backwards1(['POP', 'POP'|Code]);
peep_hole_backwards1(['POP', _, 'PUSH1'|Code]) ->
peep_hole_backwards1(Code);
peep_hole_backwards1([I|Code]) ->
[I|peep_hole_backwards1(Code)];
peep_hole_backwards1([]) ->
[].
%% Jump optimization:
%% Replaces a jump to a jump with a jump to the final destination
%% Moves basic blocks to eliminate an unconditional jump to them.
%% The compilation of conditionals generates a lot of labels and
%% jumps, some of them unnecessary. This optimization phase reorders
%% code so that as many jumps as possible can be eliminated, and
%% replaced by just falling through to the destination label. This
%% both optimizes the code generated by conditionals, and converts one
%% call of a function into falling through into its code--so it
%% reorders code quite aggressively. Function returns are indirect
%% jumps, however, and are never optimized away.
%% IMPORTANT: since execution begins at address zero, then the first
%% block of code must never be moved elsewhere. The code below has
%% this property, because it processes blocks from left to right, and
%% because the first block does not begin with a label, and so can
%% never be jumped to--hence no code can be inserted before it.
%% The optimization works by taking one block of code at a time, and
%% then prepending blocks that jump directly to it, and appending
%% blocks that it jumps directly to, resulting in a jump-free sequence
%% that is as long as possible. To do so, we store blocks in the form
%% {OptionalLabel, Body, OptionalJump} which represents the code block
%% OptionalLabel++Body++OptionalJump; the optional parts are the empty
%% list of instructions if not present. Two blocks can be merged if
%% the first ends in an OptionalJump to the OptionalLabel beginning
%% the second; the OptionalJump can then be removed (and the
%% OptionalLabel if there are no other references to it--this happens
%% during dead code elimination.
%% TODO: the present implementation is QUADRATIC, because we search
%% repeatedly for matching blocks to merge with the first one, storing
%% the blocks in a list. A near linear time implementation could use
%% two ets tables, one keyed on the labels, and the other keyed on the
%% final jumps.
optimize_jumps(Code) ->
JJs = jumps_to_jumps(Code),
ShortCircuited = [short_circuit_jumps(JJs, Instr) || Instr <- Code],
NoDeadCode = eliminate_dead_code(ShortCircuited),
MovedCode = merge_blocks(moveable_blocks(NoDeadCode)),
%% Moving code may have made some labels superfluous.
eliminate_dead_code(MovedCode).
jumps_to_jumps([{'JUMPDEST', Label}, {push_label, Target}, 'JUMP'|More]) ->
[{Label, Target}|jumps_to_jumps(More)];
jumps_to_jumps([{'JUMPDEST', Label}, {'JUMPDEST', Target}|More]) ->
[{Label, Target}|jumps_to_jumps([{'JUMPDEST', Target}|More])];
jumps_to_jumps([_|More]) ->
jumps_to_jumps(More);
jumps_to_jumps([]) ->
[].
short_circuit_jumps(JJs, {push_label, Lab}) ->
case proplists:get_value(Lab, JJs) of
undefined ->
{push_label, Lab};
Target ->
%% I wonder if this will ever loop infinitely?
short_circuit_jumps(JJs, {push_label, Target})
end;
short_circuit_jumps(_JJs, Instr) ->
Instr.
eliminate_dead_code(Code) ->
Jumps = lists:usort([Lab || {push_label, Lab} <- Code]),
NewCode = live_code(Jumps, Code),
if Code==NewCode ->
Code;
true ->
eliminate_dead_code(NewCode)
end.
live_code(Jumps, ['JUMP'|More]) ->
['JUMP'|dead_code(Jumps, More)];
live_code(Jumps, ['STOP'|More]) ->
['STOP'|dead_code(Jumps, More)];
live_code(Jumps, [{'JUMPDEST', Lab}|More]) ->
case lists:member(Lab, Jumps) of
true ->
[{'JUMPDEST', Lab}|live_code(Jumps, More)];
false ->
live_code(Jumps, More)
end;
live_code(Jumps, [I|More]) ->
[I|live_code(Jumps, More)];
live_code(_, []) ->
[].
dead_code(Jumps, [{'JUMPDEST', Lab}|More]) ->
case lists:member(Lab, Jumps) of
true ->
[{'JUMPDEST', Lab}|live_code(Jumps, More)];
false ->
dead_code(Jumps, More)
end;
dead_code(Jumps, [_I|More]) ->
dead_code(Jumps, More);
dead_code(_, []) ->
[].
%% Split the code into "moveable blocks" that control flow only
%% reaches via jumps.
moveable_blocks([]) ->
[];
moveable_blocks([I]) ->
[[I]];
moveable_blocks([Jump|More]) when Jump=='JUMP'; Jump=='STOP' ->
[[Jump]|moveable_blocks(More)];
moveable_blocks([I|More]) ->
[Block|MoreBlocks] = moveable_blocks(More),
[[I|Block]|MoreBlocks].
%% Merge blocks to eliminate jumps where possible.
merge_blocks(Blocks) ->
BlocksAndTargets = [label_and_jump(B) || B <- Blocks],
[I || {Pref, Body, Suff} <- merge_after(BlocksAndTargets),
I <- Pref++Body++Suff].
%% Merge the first block with other blocks that come after it
merge_after(All=[{Label, Body, [{push_label, Target}, 'JUMP']}|BlocksAndTargets]) ->
case [{B, J} || {[{'JUMPDEST', L}], B, J} <- BlocksAndTargets,
L == Target] of
[{B, J}|_] ->
merge_after([{Label, Body ++ [{'JUMPDEST', Target}] ++ B, J}|
lists:delete({[{'JUMPDEST', Target}], B, J},
BlocksAndTargets)]);
[] ->
merge_before(All)
end;
merge_after(All) ->
merge_before(All).
%% The first block cannot be merged with any blocks that it jumps
%% to... but maybe it can be merged with a block that jumps to it!
merge_before([Block={[{'JUMPDEST', Label}], Body, Jump}|BlocksAndTargets]) ->
case [{L, B, T} || {L, B, [{push_label, T}, 'JUMP']} <- BlocksAndTargets,
T == Label] of
[{L, B, T}|_] ->
merge_before([{L, B ++ [{'JUMPDEST', Label}] ++ Body, Jump}
|lists:delete({L, B, [{push_label, T}, 'JUMP']}, BlocksAndTargets)]);
_ ->
[Block | merge_after(BlocksAndTargets)]
end;
merge_before([Block|BlocksAndTargets]) ->
[Block | merge_after(BlocksAndTargets)];
merge_before([]) ->
[].
%% Convert each block to a PREFIX, which is a label or empty, a
%% middle, and a SUFFIX which is a JUMP to a label, or empty.
label_and_jump(B) ->
{Label, B1} = case B of
[{'JUMPDEST', L}|More1] ->
{[{'JUMPDEST', L}], More1};
_ ->
{[], B}
end,
{Target, B2} = case lists:reverse(B1) of
['JUMP', {push_label, T}|More2] ->
{[{push_label, T}, 'JUMP'], lists:reverse(More2)};
_ ->
{[], B1}
end,
{Label, B2, Target}.

View File

@ -1,25 +1,20 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2018, Aeternity Anstalt
%%% @doc Parser combinators for the Sophia parser. Based on
%%% Koen Claessen. 2004. Parallel Parsing Processes. J. Functional
%%% Programming 14, 6 (November 2004)
%%% @end
%%%-------------------------------------------------------------------
-module(so_parse_lib).
-vsn("9.0.0").
-module(aeso_parse_lib).
-export([parse/2,
return/1, fail/0, fail/1, fail/2, map/2, bind/2,
return/1, fail/0, fail/1, map/2, bind/2,
lazy/1, choice/1, choice/2, tok/1, layout/0,
left/2, right/2, between/3, optional/1,
many/1, many1/1, sep/2, sep1/2,
infixl/2, infixr/2]).
-export([current_file/0, set_current_file/1, current_dir/0, set_current_dir/1,
current_include_type/0, set_current_include_type/1]).
%% -- Types ------------------------------------------------------------------
-export_type([parser/1, parser_expr/1, pos/0, token/0, tokens/0]).
@ -29,16 +24,16 @@
-type tokens() :: [token()].
-type error() :: {pos(), string() | no_error}.
-define(lazy(F), {so_parse_lazy, F}).
-define(fail(Err), {so_parse_fail, Err}).
-define(choice(Ps), {so_parse_choice, Ps}).
-define(bind(P, F), {so_parse_bind, P, F}).
-define(right(P, Q), {so_parse_right, P, Q}).
-define(left(P, Q), {so_parse_left, P, Q}).
-define(map(F, P), {so_parse_map, F, P}).
-define(layout, so_parse_layout).
-define(tok(Atom), {so_parse_tok, Atom}).
-define(return(X), {so_parse_return, X}).
-define(lazy(F), {aeso_parse_lazy, F}).
-define(fail(Err), {aeso_parse_fail, Err}).
-define(choice(Ps), {aeso_parse_choice, Ps}).
-define(bind(P, F), {aeso_parse_bind, P, F}).
-define(right(P, Q), {aeso_parse_right, P, Q}).
-define(left(P, Q), {aeso_parse_left, P, Q}).
-define(map(F, P), {aeso_parse_map, F, P}).
-define(layout, aeso_parse_layout).
-define(tok(Atom), {aeso_parse_tok, Atom}).
-define(return(X), {aeso_parse_return, X}).
%% Type synonyms since you can't have function types as macro arguments for some reason.
-type delayed(A) :: fun(() -> A).
@ -77,31 +72,25 @@
%% first argument. I.e. no backtracking to the second argument if the first
%% fails.
trampoline({bounce, Cont}) when is_function(Cont, 0) ->
trampoline(Cont());
trampoline(Res) ->
Res.
-define(BOUNCE(X), {bounce, fun() -> X end}).
%% Apply a parser to its continuation. This compiles a parser to its low-level representation.
-spec apply_p(parser(A), fun((A) -> parser1(B))) -> parser1(B).
apply_p(?lazy(F), K) -> apply_p(F(), K);
apply_p(?fail(Err), _) -> {fail, Err};
apply_p(?choice([P | Ps]), K) -> lists:foldl(fun(Q, R) -> choice1(trampoline(apply_p(Q, K)), R) end,
trampoline(apply_p(P, K)), Ps);
apply_p(?choice([P | Ps]), K) -> lists:foldl(fun(Q, R) -> choice1(apply_p(Q, K), R) end,
apply_p(P, K), Ps);
apply_p(?bind(P, F), K) -> apply_p(P, fun(X) -> apply_p(F(X), K) end);
apply_p(?right(P, Q), K) -> apply_p(P, fun(_) -> apply_p(Q, K) end);
apply_p(?left(P, Q), K) -> apply_p(P, fun(X) -> apply_p(Q, fun(_) -> K(X) end) end);
apply_p(?map(F, P), K) -> apply_p(P, fun(X) -> K(F(X)) end);
apply_p(?layout, K) -> {layout, K, {fail, {expected, layout_block}}};
apply_p(?tok(Atom), K) -> {tok_bind, #{Atom => K}};
apply_p(?return(X), K) -> ?BOUNCE(K(X));
apply_p(?return(X), K) -> K(X);
apply_p([P | Q], K) -> apply_p(P, fun(H) -> apply_p(Q, fun(T) -> K([H | T]) end) end);
apply_p(T, K) when is_tuple(T) -> apply_p(tuple_to_list(T), fun(Xs) -> K(list_to_tuple(Xs)) end);
apply_p(M, K) when is_map(M) ->
{Keys, Ps} = lists:unzip(maps:to_list(M)),
apply_p(Ps, fun(Vals) -> K(maps:from_list(lists:zip(Keys, Vals))) end);
apply_p(X, K) -> ?BOUNCE(K(X)).
apply_p(X, K) -> K(X).
%% -- Primitive combinators --------------------------------------------------
@ -109,10 +98,6 @@ apply_p(X, K) -> ?BOUNCE(K(X)).
-spec lazy(fun(() -> parser(A))) -> parser(A).
lazy(Delayed) -> ?lazy(Delayed).
%% @doc A parser that always fails at a known location.
-spec fail(pos(), term()) -> parser(none()).
fail(Pos, Err) -> ?fail({Pos, Err}).
%% @doc A parser that always fails.
-spec fail(term()) -> parser(none()).
fail(Err) -> ?fail(Err).
@ -169,8 +154,8 @@ layout() -> ?layout.
%% @doc Parse a sequence of tokens using a parser. Fails if the parse is ambiguous.
-spec parse(parser(A), tokens()) -> {ok, A} | {error, term()}.
parse(P, S) ->
case parse1(trampoline(apply_p(P, fun(X) -> {return_plus, X, {fail, no_error}} end)), S) of
{[], {Pos, Err}} -> {error, {add_current_file(Pos), parse_error, flatten_error(Err)}};
case parse1(apply_p(P, fun(X) -> {return_plus, X, {fail, no_error}} end), S) of
{[], {Pos, Err}} -> {error, {Pos, parse_error, flatten_error(Err)}};
{[A], _} -> {ok, A};
{As, _} -> {error, {{1, 1}, ambiguous_parse, As}}
end.
@ -250,7 +235,7 @@ col(T) when is_tuple(T) -> element(2, pos(T)).
%% If both parsers want the next token we grab it and merge the continuations.
choice1({tok_bind, Map1}, {tok_bind, Map2}) ->
{tok_bind, merge_with(fun(F, G) -> fun(T) -> choice1(trampoline(F(T)), trampoline(G(T))) end end, Map1, Map2)};
{tok_bind, merge_with(fun(F, G) -> fun(T) -> choice1(F(T), G(T)) end end, Map1, Map2)};
%% If both parsers fail we combine the error messages. If only one fails we discard it.
choice1({fail, E1}, {fail, E2}) -> {fail, add_error(E1, E2)};
@ -264,7 +249,7 @@ choice1(P, {return_plus, X, Q}) -> {return_plus, X, choice1(P, Q)};
%% If both sides want a layout block we combine them. If only one side wants a layout block we
%% will commit to a layout block is there is one.
choice1({layout, F, P}, {layout, G, Q}) ->
{layout, fun(N) -> choice1(trampoline(F(N)), trampoline(G(N))) end, choice1(P, Q)};
{layout, fun(N) -> choice1(F(N), G(N)) end, choice1(P, Q)};
choice1({layout, F, P}, Q) -> {layout, F, choice1(P, Q)};
choice1(P, {layout, G, Q}) -> {layout, G, choice1(P, Q)}.
@ -287,8 +272,6 @@ parse1(P, S) ->
%% The main work horse. Returns a list of possible parses and an error message in case parsing
%% fails.
-spec parse1(parser1(A), #ts{}, [A], term()) -> {[A], error()}.
parse1({bounce, F}, Ts, Acc, Err) ->
parse1(F(), Ts, Acc, Err);
parse1({tok_bind, Map}, Ts, Acc, Err) ->
case next_token(Ts) of
{T, Ts1} ->
@ -302,7 +285,7 @@ parse1({tok_bind, Map}, Ts, Acc, Err) ->
%% y + y)(4)
case maps:get(vclose, Map, '$not_found') of
'$not_found' ->
{Acc, unexpected_token_error(Ts, maps:keys(Map), T)};
{Acc, unexpected_token_error(Ts, T)};
F ->
VClose = {vclose, pos(T)},
Ts2 = pop_layout(VClose, Ts#ts{ last = VClose }),
@ -339,52 +322,12 @@ current_pos(#ts{ tokens = [T | _] }) -> pos(T);
current_pos(#ts{ last = T }) -> end_pos(pos(T)).
-spec mk_error(#ts{}, term()) -> error().
mk_error(_Ts, {Pos, Err}) ->
{Pos, Err};
mk_error(Ts, Err) ->
{current_pos(Ts), Err}.
-spec unexpected_token_error(#ts{}, token()) -> error().
unexpected_token_error(Ts, T) ->
unexpected_token_error(Ts, [], T).
unexpected_token_error(Ts, Expect, {Tag, _}) when Tag == vclose; Tag == vsemi ->
Braces = [')', ']', '}'],
Fix = case lists:filter(fun(T) -> lists:member(T, Braces) end, Expect) of
[] -> " Probable causes:\n"
" - something is missing in the previous statement, or\n"
" - this line should be indented more.";
[T | _] -> io_lib:format(" Did you forget a ~p?", [T])
end,
Msg = io_lib:format("Unexpected indentation.~s", [Fix]),
mk_error(Ts, Msg);
unexpected_token_error(Ts, Expect, T) ->
ExpectCon = lists:member(con, Expect),
ExpectId = lists:member(id, Expect),
Fix = case T of
{id, _, X} when ExpectCon, hd(X) /= $_ -> io_lib:format(" Did you mean ~s?", [mk_upper(X)]);
{con, _, X} when ExpectId -> io_lib:format(" Did you mean ~s?", [mk_lower(X)]);
{qcon, _, Xs} when ExpectCon -> io_lib:format(" Did you mean ~s?", [lists:last(Xs)]);
{qid, _, Xs} when ExpectId -> io_lib:format(" Did you mean ~s?", [lists:last(Xs)]);
_ -> ""
end,
mk_error(Ts, io_lib:format("Unexpected ~s.~s", [describe(T), Fix])).
mk_upper([C | Rest]) -> string:to_upper([C]) ++ Rest.
mk_lower([C | Rest]) -> string:to_lower([C]) ++ Rest.
describe({id, _, X}) -> io_lib:format("identifier ~s", [X]);
describe({con, _, X}) -> io_lib:format("identifier ~s", [X]);
describe({qid, _, Xs}) -> io_lib:format("qualified identifier ~s", [string:join(Xs, ".")]);
describe({qcon, _, Xs}) -> io_lib:format("qualified identifier ~s", [string:join(Xs, ".")]);
describe({tvar, _, X}) -> io_lib:format("type variable ~s", [X]);
describe({char, _, _}) -> "character literal";
describe({string, _, _}) -> "string literal";
describe({hex, _, _}) -> "integer literal";
describe({int, _, _}) -> "integer literal";
describe({bytes, _, _}) -> "bytes literal";
describe(T) -> io_lib:format("token '~s'", [tag(T)]).
mk_error(Ts, io_lib:format("Unexpected token ~p", [tag(T)])).
%% Get the next token from a token stream. Inserts layout tokens if necessary.
-spec next_token(#ts{}) -> false | {token(), #ts{}}.
@ -468,27 +411,3 @@ merge_with(Fun, Map1, Map2) ->
end, Map2, maps:to_list(Map1))
end.
%% Current include type
current_include_type() ->
get('$current_include_type').
set_current_include_type(IncludeType) ->
put('$current_include_type', IncludeType).
%% Current source file
current_file() ->
get('$current_file').
set_current_file(File) ->
put('$current_file', File).
%% Current source directory
current_dir() ->
get('$current_dir').
set_current_dir(File) ->
put('$current_dir', File).
add_current_file({L, C}) -> {current_file(), L, C};
add_current_file(Pos) -> Pos.

25
src/aeso_parse_lib.hrl Normal file
View File

@ -0,0 +1,25 @@
-define(LET_P(X, P, Q), aeso_parse_lib:bind(P, fun(X) -> Q end)).
-define(LAZY_P(P), aeso_parse_lib:lazy(fun() -> P end)).
-define(MEMO_P(P), aeso_parse_lib:lazy(aeso_parse_lib:memoised(fun() -> P end))).
-define(GUARD_P(G, P),
case G of
true -> P;
false -> fail()
end).
-define(RULE(A, Do), map(fun(_1) -> Do end, A )).
-define(RULE(A, B, Do), map(fun({_1, _2}) -> Do end, {A, B} )).
-define(RULE(A, B, C, Do), map(fun({_1, _2, _3}) -> Do end, {A, B, C} )).
-define(RULE(A, B, C, D, Do), map(fun({_1, _2, _3, _4}) -> Do end, {A, B, C, D} )).
-define(RULE(A, B, C, D, E, Do), map(fun({_1, _2, _3, _4, _5}) -> Do end, {A, B, C, D, E} )).
-define(RULE(A, B, C, D, E, F, Do), map(fun({_1, _2, _3, _4, _5, _6}) -> Do end, {A, B, C, D, E, F})).
-import(aeso_parse_lib,
[tok/1, tok/2, between/3, many/1, many1/1, sep/2, sep1/2,
infixl/1, infixr/1, choice/1, choice/2, return/1, layout/0,
fail/0, fail/1, map/2, infixl/2, infixr/2, infixl1/2, infixr1/2,
left/2, right/2, optional/1]).

View File

@ -1,95 +1,53 @@
%%% File : so_parser.erl
%%% File : aeso_parser.erl
%%% Author : Ulf Norell
%%% Description :
%%% Created : 1 Mar 2018 by Ulf Norell
-module(so_parser).
-vsn("9.0.0").
-compile({no_auto_import,[map_get/2]}).
-module(aeso_parser).
-export([string/1,
string/2,
string/3,
auto_imports/1,
hash_include/2,
decl/0,
type/0,
body/0,
maybe_block/1,
run_parser/2,
run_parser/3]).
type/1]).
-include("so_parse_lib.hrl").
-import(so_parse_lib, [current_file/0, set_current_file/1,
current_dir/0, set_current_dir/1,
current_include_type/0, set_current_include_type/1]).
-include("aeso_parse_lib.hrl").
-type parse_result() :: so_syntax:ast() | {so_syntax:ast(), sets:set(include_hash())} | none().
-type parse_result() :: {ok, aeso_syntax:ast()}
| {error, {aeso_parse_lib:pos(), atom(), term()}}
| {error, {aeso_parse_lib:pos(), atom()}}.
-type include_hash() :: {string(), binary()}.
escape_errors({ok, Ok}) ->
Ok;
escape_errors({error, Err}) ->
parse_error(Err).
-spec string(string()) -> parse_result().
string(String) ->
string(String, sets:new(), []).
-spec string(string(), so_compiler:options()) -> parse_result().
-spec string(string(), aeso_compiler:options()) -> parse_result().
string(String, Opts) ->
case lists:keyfind(src_file, 1, Opts) of
{src_file, File} -> string(String, sets:add_element(File, sets:new()), Opts);
false -> string(String, sets:new(), Opts)
end.
-spec string(string(), sets:set(include_hash()), so_compiler:options()) -> parse_result().
-spec string(string(), sets:set(include_hash()), aeso_compiler:options()) -> parse_result().
string(String, Included, Opts) ->
AST = run_parser(file(), String, Opts),
case expand_includes(AST, Included, Opts) of
{ok, AST1} -> AST1;
{error, Err} -> parse_error(Err)
case parse_and_scan(file(), String, Opts) of
{ok, AST} ->
expand_includes(AST, Included, Opts);
Err = {error, _} ->
Err
end.
run_parser(P, Inp) ->
escape_errors(parse_and_scan(P, Inp, [])).
run_parser(P, Inp, Opts) ->
escape_errors(parse_and_scan(P, Inp, Opts)).
type(String) ->
parse_and_scan(type(), String, []).
parse_and_scan(P, S, Opts) ->
set_current_file(proplists:get_value(src_file, Opts, no_file)),
set_current_dir(proplists:get_value(src_dir, Opts, no_file)),
set_current_include_type(proplists:get_value(include_type, Opts, none)),
case so_scan:scan(S) of
{ok, Tokens} -> so_parse_lib:parse(P, Tokens);
{error, {{Input, Pos}, _}} ->
{error, {Pos, scan_error, Input}}
case aeso_scan:scan(S) of
{ok, Tokens} -> aeso_parse_lib:parse(P, Tokens);
Error -> Error
end.
-dialyzer({nowarn_function, parse_error/1}).
parse_error(Err) ->
so_errors:throw(mk_error(Err)).
mk_p_err(Pos, Msg) ->
so_errors:new(parse_error, mk_pos(Pos), lists:flatten(Msg)).
mk_error({Pos, scan_error, Input}) ->
mk_p_err(Pos, io_lib:format("Lexical error on input: ~s\n", [Input]));
mk_error({Pos, parse_error, Err}) ->
Msg = io_lib:format("~s\n", [Err]),
mk_p_err(Pos, Msg);
mk_error({Pos, ambiguous_parse, As}) ->
Msg = io_lib:format("Ambiguous parse result: ~p\n", [As]),
mk_p_err(Pos, Msg);
mk_error({Pos, include_error, File}) ->
Msg = io_lib:format("Couldn't find include file '~s'\n", [File]),
mk_p_err(Pos, Msg).
mk_pos({Line, Col}) -> so_errors:pos(Line, Col);
mk_pos({File, Line, Col}) -> so_errors:pos(File, Line, Col).
%% -- Parsing rules ----------------------------------------------------------
file() -> choice([], block(decl())).
@ -98,36 +56,10 @@ decl() ->
?LAZY_P(
choice(
%% Contract declaration
[ ?RULE(token(main), keyword(contract),
con(), tok('='), maybe_block(decl()), {contract_main, _2, _3, [], _5})
, ?RULE(token(main), keyword(contract),
con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), {contract_main, _2, _3, _5, _7})
, ?RULE(keyword(contract),
con(), tok('='), maybe_block(decl()), {contract_child, _1, _2, [], _4})
, ?RULE(keyword(contract),
con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), {contract_child, _1, _2, _4, _6})
, ?RULE(keyword(contract), token(interface),
con(), tok('='), maybe_block(decl()), {contract_interface, _1, _3, [], _5})
, ?RULE(keyword(contract), token(interface),
con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), {contract_interface, _1, _3, _5, _7})
, ?RULE(token(payable), token(main), keyword(contract),
con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_main, _3, _4, [], _6}))
, ?RULE(token(payable), token(main), keyword(contract),
con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_main, _3, _4, _6, _8}))
, ?RULE(token(payable), keyword(contract),
con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_child, _2, _3, [], _5}))
, ?RULE(token(payable), keyword(contract),
con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_child, _2, _3, _5, _7}))
, ?RULE(token(payable), keyword(contract), token(interface),
con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_interface, _2, _4, [], _6}))
, ?RULE(token(payable), keyword(contract), token(interface),
con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_interface, _2, _4, _6, _8}))
[ ?RULE(keyword(contract), con(), tok('='), maybe_block(decl()), {contract, _1, _2, _4})
, ?RULE(token(payable), keyword(contract), con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract, _2, _3, _5}))
, ?RULE(keyword(namespace), con(), tok('='), maybe_block(decl()), {namespace, _1, _2, _4})
, ?RULE(keyword(include), str(), {include, get_ann(_1), _2})
, using()
, pragma()
%% Type declarations TODO: format annotation for "type bla" vs "type bla()"
, ?RULE(keyword(type), id(), {type_decl, _1, _2, []})
@ -140,46 +72,13 @@ decl() ->
, ?RULE(keyword(datatype), id(), type_vars(), tok('='), typedef(variant), {type_def, _1, _2, _3, _5})
%% Function declarations
, ?RULE(modifiers(), fun_or_entry(), maybe_block(fundef_or_decl()), fun_block(_1, _2, _3))
, ?RULE(keyword('let'), valdef(), set_pos(get_pos(_1), _2))
, ?RULE(modifiers(), fun_or_entry(), id(), tok(':'), type(), add_modifiers(_1, _2, {fun_decl, get_ann(_2), _3, _5}))
, ?RULE(modifiers(), fun_or_entry(), fundef(), add_modifiers(_1, _2, set_pos(get_pos(get_ann(_2)), _3)))
, ?RULE(keyword('let'), valdef(), set_pos(get_pos(_1), _2))
])).
fun_block(Mods, Kind, [Decl]) ->
add_modifiers(Mods, Kind, set_pos(get_pos(Kind), Decl));
fun_block(Mods, Kind, Decls) ->
{block, get_ann(Kind), [ add_modifiers(Mods, Kind, Decl) || Decl <- Decls ]}.
fundef_or_decl() ->
choice([?RULE(id(), tok(':'), type(), {fun_decl, get_ann(_1), _1, _3}),
fundef()]).
using() ->
Alias = {keyword(as), con()},
For = ?RULE(keyword(for), bracket_list(id()), {for, _2}),
Hiding = ?RULE(keyword(hiding), bracket_list(id()), {hiding, _2}),
?RULE(keyword(using), con(), optional(Alias), optional(choice(For, Hiding)), using(get_ann(_1), _2, _3, _4)).
using(Ann, Con, none, none) ->
{using, Ann, Con, none, none};
using(Ann, Con, {ok, {_, Alias}}, none) ->
{using, Ann, Con, Alias, none};
using(Ann, Con, none, {ok, List}) ->
{using, Ann, Con, none, List};
using(Ann, Con, {ok, {_, Alias}}, {ok, List}) ->
{using, Ann, Con, Alias, List}.
pragma() ->
Op = choice([token(T) || T <- ['<', '=<', '==', '>=', '>']]),
?RULE(tok('@'), id("compiler"), Op, version(), {pragma, get_ann(_1), {compiler, element(1, _3), _4}}).
version() ->
?RULE(token(int), many({tok('.'), token(int)}), mk_version(_1, _2)).
mk_version({int, _, Maj}, Rest) ->
[Maj | [N || {_, {int, _, N}} <- Rest]].
fun_or_entry() ->
choice([?RULE(keyword(function), {function, _1}),
choice([?RULE(keyword(function), {function, _1}),
?RULE(keyword(entrypoint), {entrypoint, _1})]).
modifiers() ->
@ -226,30 +125,22 @@ letdecl() ->
letdef() -> choice(valdef(), fundef()).
valdef() ->
?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}).
guarded_fundefs() ->
choice(
[ ?RULE(keyword('='), body(), [{guarded, _1, [], _2}])
, maybe_block(?RULE(keyword('|'), comma_sep(expr()), tok('='), body(), {guarded, _1, _2, _4}))
]).
?RULE(id(), tok('='), body(), {letval, [], _1, type_wildcard(), _3}),
?RULE(id(), tok(':'), type(), tok('='), body(), {letval, [], _1, _3, _5})).
fundef() ->
choice(
[ ?RULE(id(), args(), guarded_fundefs(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _3})
, ?RULE(id(), args(), tok(':'), type(), guarded_fundefs(), {letfun, get_ann(_1), _1, _2, _4, _5})
[ ?RULE(id(), args(), tok('='), body(), {letfun, [], _1, _2, type_wildcard(), _4})
, ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, [], _1, _2, _4, _6})
]).
args() -> paren_list(pattern()).
lam_args() -> paren_list(arg()).
args() -> paren_list(arg()).
arg() -> choice(
?RULE(id(), {arg, get_ann(_1), _1, type_wildcard(get_ann(_1))}),
?RULE(id(), {arg, get_ann(_1), _1, type_wildcard()}),
?RULE(id(), tok(':'), type(), {arg, get_ann(_1), _1, _3})).
letpat() ->
?RULE(keyword('('), id(), tok('='), pattern(), tok(')'), {letpat, get_ann(_1), _2, _4}).
%% -- Types ------------------------------------------------------------------
type_vars() -> paren_list(tvar()).
@ -267,11 +158,10 @@ type300() ->
type400() ->
choice(
[?RULE(typeAtom(), optional(type_args()),
any_bytes(
case _2 of
none -> _1;
{ok, Args} -> {app_t, get_ann(_1), _1, Args}
end)),
case _2 of
none -> _1;
{ok, Args} -> {app_t, get_ann(_1), _1, Args}
end),
?RULE(id("bytes"), parens(token(int)),
{bytes_t, get_ann(_1), element(3, _2)})
]).
@ -297,26 +187,19 @@ body() ->
stmt() ->
?LAZY_P(choice(
[ using()
, expr()
[ expr()
, letdecl()
, {switch, keyword(switch), parens(expr()), maybe_block(branch())}
, {'if', keyword('if'), parens(expr()), body()}
, {elif, keyword(elif), parens(expr()), body()}
, {'else', keyword('else'), body()}
, {else, keyword(else), body()}
])).
branch() ->
?RULE(pattern(), guarded_branches(), {'case', get_ann(lists:nth(1, _2)), _1, _2}).
guarded_branches() ->
choice(
[ ?RULE(keyword('=>'), body(), [{guarded, _1, [], _2}])
, maybe_block(?RULE(tok('|'), comma_sep(expr()), keyword('=>'), body(), {guarded, _3, _2, _4}))
]).
?RULE(pattern(), keyword('=>'), body(), {'case', _2, _1, _3}).
pattern() ->
?LET_P(E, expr(), parse_pattern(E)).
?LET_P(E, expr500(), parse_pattern(E)).
%% -- Expressions ------------------------------------------------------------
@ -324,39 +207,33 @@ expr() -> expr100().
expr100() ->
Expr100 = ?LAZY_P(expr100()),
Expr150 = ?LAZY_P(expr150()),
Expr200 = ?LAZY_P(expr200()),
choice(
[ ?RULE(lam_args(), keyword('=>'), body(), {lam, _2, _1, _3}) %% TODO: better location
, {'if', keyword('if'), parens(Expr100), Expr150, right(tok('else'), Expr100)}
, ?RULE(Expr150, optional(right(tok(':'), type())),
[ ?RULE(args(), keyword('=>'), body(), {lam, _2, _1, _3}) %% TODO: better location
, {'if', keyword('if'), parens(Expr100), Expr200, right(tok(else), Expr100)}
, ?RULE(Expr200, optional(right(tok(':'), type())),
case _2 of
none -> _1;
{ok, Type} -> {typed, get_ann(_1), _1, Type}
end)
]).
expr150() -> infixl(expr200(), binop('|>')).
expr200() -> infixr(expr300(), binop('||')).
expr300() -> infixr(expr325(), binop('&&')).
expr325() -> infixl(expr350(), binop('bor')).
expr350() -> infixl(expr375(), binop('bxor')).
expr375() -> infixl(expr400(), binop('band')).
expr300() -> infixr(expr400(), binop('&&')).
expr400() -> infix(expr500(), binop(['<', '>', '=<', '>=', '==', '!='])).
expr500() -> infixr(expr550(), binop(['::', '++'])).
expr550() -> infixl(expr600(), binop(['<<', '>>'])).
expr500() -> infixr(expr600(), binop(['::', '++'])).
expr600() -> infixl(expr650(), binop(['+', '-'])).
expr650() -> ?RULE(many(token('-')), expr700(), prefixes(_1, _2)).
expr700() -> infixl(expr750(), binop(['*', '/', mod])).
expr750() -> infixl(expr800(), binop(['^'])).
expr800() -> ?RULE(many(token('!')), expr850(), prefixes(_1, _2)).
expr850() -> ?RULE(many(token('bnot')), expr900(), prefixes(_1, _2)).
expr800() -> ?RULE(many(token('!')), expr900(), prefixes(_1, _2)).
expr900() -> ?RULE(exprAtom(), many(elim()), elim(_1, _2)).
exprAtom() ->
?LAZY_P(begin
Expr = ?LAZY_P(expr()),
choice(
[ id_or_addr(), con(), token(qid), token(qcon), binop_as_lam()
[ id_or_addr(), con(), token(qid), token(qcon)
, token(bytes), token(string), token(char)
, token(int)
, ?RULE(token(hex), set_ann(format, hex, setelement(1, _1, int)))
@ -367,13 +244,9 @@ exprAtom() ->
, ?RULE(keyword('['), Expr, token('|'), comma_sep(comprehension_exp()), tok(']'), list_comp_e(_1, _2, _4))
, ?RULE(tok('['), Expr, binop('..'), Expr, tok(']'), _3(_2, _4))
, ?RULE(keyword('('), comma_sep(Expr), tok(')'), tuple_e(_1, _2))
, letpat()
, hole()
])
end).
hole() -> ?RULE(token('???'), {id, get_ann(_1), "???"}).
comprehension_exp() ->
?LAZY_P(choice(
[ comprehension_bind()
@ -385,7 +258,7 @@ comprehension_if() ->
?RULE(keyword('if'), parens(expr()), {comprehension_if, _1, _2}).
comprehension_bind() ->
?RULE(pattern(), tok('<-'), expr(), {comprehension_bind, _1, _3}).
?RULE(id(), tok('<-'), expr(), {comprehension_bind, _1, _3}).
arg_expr() ->
?LAZY_P(
@ -412,7 +285,7 @@ map_key(Key, {ok, {_, Val}}) -> {map_key, Key, Val}.
elim(E, []) -> E;
elim(E, [{proj, Ann, P} | Es]) -> elim({proj, Ann, E, P}, Es);
elim(E, [{app, _Ann, Args} | Es]) -> elim({app, so_syntax:get_ann(E), E, Args}, Es);
elim(E, [{app, Ann, Args} | Es]) -> elim({app, Ann, E, Args}, Es);
elim(E, [{rec_upd, Ann, Flds} | Es]) -> elim(record_update(Ann, E, Flds), Es);
elim(E, [{map_get, Ann, Key} | Es]) -> elim({map_get, Ann, E, Key}, Es);
elim(E, [{map_get, Ann, Key, Val} | Es]) -> elim({map_get, Ann, E, Key, Val}, Es).
@ -437,9 +310,7 @@ record(Fs) ->
bad_expr_err("Cannot use '@' in map construction", infix({lvalue, FAnn, LV}, {'@', Ann}, Id));
({field, FAnn, LV, _}) ->
bad_expr_err("Cannot use nested fields or keys in map construction", {lvalue, FAnn, LV}) end,
{map, Ann, lists:map(KV, Fs)};
record_or_map_error ->
{record_or_map_error, get_ann(hd(Fs)), Fs}
{map, Ann, lists:map(KV, Fs)}
end.
record_or_map(Fields) ->
@ -451,7 +322,9 @@ record_or_map(Fields) ->
case lists:usort(lists:map(Kind, Fields)) of
[proj] -> record;
[map_get] -> map;
_ -> record_or_map_error %% Defer error until type checking
_ ->
[{field, Ann, _, _} | _] = Fields,
bad_expr_err("Mixed record fields and map keys in", {record, Ann, Fields})
end.
field_assignment() ->
@ -496,19 +369,6 @@ id() -> token(id).
tvar() -> token(tvar).
str() -> token(string).
binop_as_lam() ->
BinOps = ['&&', '||',
'+', '-', '*', '/', '^', 'mod',
'==', '!=', '<', '>', '<=', '=<', '>=',
'::', '++', '|>'],
OpToLam = fun(Op = {_, Ann}) ->
IdL = {id, Ann, "l"},
IdR = {id, Ann, "r"},
Arg = fun(Id) -> {arg, Ann, Id, type_wildcard(Ann)} end,
{lam, Ann, [Arg(IdL), Arg(IdR)], infix(IdL, Op, IdR)}
end,
?RULE(parens(choice(lists:map(fun token/1, BinOps))), OpToLam(_1)).
token(Tag) ->
?RULE(tok(Tag),
case _1 of
@ -519,17 +379,17 @@ token(Tag) ->
id(Id) ->
?LET_P({id, A, X} = Y, id(),
if X == Id -> Y;
true -> fail({A, "expected '" ++ Id ++ "'"})
true -> fail({A, "expected 'bytes'"})
end).
id_or_addr() ->
?RULE(id(), parse_addr_literal(_1)).
parse_addr_literal(Id = {id, Ann, Name}) ->
case lists:member(lists:sublist(Name, 3), ["ak_", "ok_", "oq_", "ct_", "sg_"]) of
case lists:member(lists:sublist(Name, 3), ["ak_", "ok_", "oq_", "ct_"]) of
false -> Id;
true ->
try gmser_api_encoder:decode(list_to_binary(Name)) of
try aeser_api_encoder:decode(list_to_binary(Name)) of
{Type, Bin} -> {Type, Ann, Bin}
catch _:_ ->
Id
@ -558,17 +418,18 @@ bracket_list(P) -> brackets(comma_sep(P)).
%% -- Annotations ------------------------------------------------------------
-type ann() :: so_syntax:ann().
-type ann_line() :: so_syntax:ann_line().
-type ann_col() :: so_syntax:ann_col().
-type ann() :: aeso_syntax:ann().
-type ann_line() :: aeso_syntax:ann_line().
-type ann_col() :: aeso_syntax:ann_col().
-spec pos_ann(ann_line(), ann_col()) -> ann().
pos_ann(Line, Col) ->
[ {file, current_file()}
, {dir, current_dir()}
, {include_type, current_include_type()}
, {line, Line}
, {col, Col} ].
pos_ann(Line, Col) -> [{file, current_file()}, {line, Line}, {col, Col}].
current_file() ->
get('$current_file').
set_current_file(File) ->
put('$current_file', File).
ann_pos(Ann) ->
{proplists:get_value(file, Ann),
@ -600,8 +461,8 @@ infix(L, Op, R) -> set_ann(format, infix, {app, get_ann(L), Op, [L, R]}).
prefixes(Ops, E) -> lists:foldr(fun prefix/2, E, Ops).
prefix(Op, E) -> set_ann(format, prefix, {app, get_ann(Op), Op, [E]}).
type_wildcard(Ann) ->
{id, [{origin, system} | Ann], "_"}.
type_wildcard() ->
{id, [{origin, system}], "_"}.
block_e(Stmts) ->
group_ifs(Stmts, []).
@ -613,7 +474,7 @@ group_ifs([], Acc) ->
group_ifs([{'if', Ann, Cond, Then} | Stmts], Acc) ->
{Elses, Rest} = else_branches(Stmts, []),
group_ifs(Rest, [build_if(Ann, Cond, Then, Elses) | Acc]);
group_ifs([{'else', Ann, _} | _], _) ->
group_ifs([{else, Ann, _} | _], _) ->
fail({Ann, "No matching 'if' for 'else'"});
group_ifs([{elif, Ann, _, _} | _], _) ->
fail({Ann, "No matching 'if' for 'elif'"});
@ -623,14 +484,14 @@ group_ifs([Stmt | Stmts], Acc) ->
build_if(Ann, Cond, Then, [{elif, Ann1, Cond1, Then1} | Elses]) ->
{'if', Ann, Cond, Then,
set_ann(format, elif, build_if(Ann1, Cond1, Then1, Elses))};
build_if(Ann, Cond, Then, [{'else', _Ann, Else}]) ->
build_if(Ann, Cond, Then, [{else, _Ann, Else}]) ->
{'if', Ann, Cond, Then, Else};
build_if(Ann, Cond, Then, []) ->
{'if', Ann, Cond, Then, {tuple, [{origin, system}], []}}.
else_branches([Elif = {elif, _, _, _} | Stmts], Acc) ->
else_branches(Stmts, [Elif | Acc]);
else_branches([Else = {'else', _, _} | Stmts], Acc) ->
else_branches([Else = {else, _, _} | Stmts], Acc) ->
{lists:reverse([Else | Acc]), Stmts};
else_branches(Stmts, Acc) ->
{lists:reverse(Acc), Stmts}.
@ -648,14 +509,10 @@ tuple_e(Ann, Exprs) -> {tuple, Ann, Exprs}.
list_comp_e(Ann, Expr, Binds) -> {list_comp, Ann, Expr, Binds}.
-spec parse_pattern(so_syntax:expr()) -> so_parse_lib:parser(so_syntax:pat()).
parse_pattern({letpat, Ann, Id, Pat}) ->
{letpat, Ann, Id, parse_pattern(Pat)};
-spec parse_pattern(aeso_syntax:expr()) -> aeso_parse_lib:parser(aeso_syntax:pat()).
parse_pattern({app, Ann, Con = {'::', _}, Es}) ->
{app, Ann, Con, lists:map(fun parse_pattern/1, Es)};
parse_pattern({app, Ann, {'-', _}, [{int, _, N}]}) ->
{int, Ann, -N};
parse_pattern({app, Ann, Con = {Tag, _, _}, Es}) when Tag == con; Tag == qcon ->
parse_pattern({app, Ann, Con = {con, _, _}, Es}) ->
{app, Ann, Con, lists:map(fun parse_pattern/1, Es)};
parse_pattern({tuple, Ann, Es}) ->
{tuple, Ann, lists:map(fun parse_pattern/1, Es)};
@ -663,10 +520,7 @@ parse_pattern({list, Ann, Es}) ->
{list, Ann, lists:map(fun parse_pattern/1, Es)};
parse_pattern({record, Ann, Fs}) ->
{record, Ann, lists:map(fun parse_field_pattern/1, Fs)};
parse_pattern({typed, Ann, E, Type}) ->
{typed, Ann, parse_pattern(E), Type};
parse_pattern(E = {con, _, _}) -> E;
parse_pattern(E = {qcon, _, _}) -> E;
parse_pattern(E = {id, _, _}) -> E;
parse_pattern(E = {int, _, _}) -> E;
parse_pattern(E = {bool, _, _}) -> E;
@ -675,19 +529,24 @@ parse_pattern(E = {string, _, _}) -> E;
parse_pattern(E = {char, _, _}) -> E;
parse_pattern(E) -> bad_expr_err("Not a valid pattern", E).
-spec parse_field_pattern(so_syntax:field(so_syntax:expr())) -> so_parse_lib:parser(so_syntax:field(so_syntax:pat())).
-spec parse_field_pattern(aeso_syntax:field(aeso_syntax:expr())) -> aeso_parse_lib:parser(aeso_syntax:field(aeso_syntax:pat())).
parse_field_pattern({field, Ann, F, E}) ->
{field, Ann, F, parse_pattern(E)}.
-spec ret_doc_err(ann(), prettypr:document()) -> so_parse_lib:parser(none()).
ret_doc_err(Ann, Doc) ->
fail(ann_pos(Ann), prettypr:format(Doc)).
return_error({no_file, L, C}, Err) ->
fail(io_lib:format("~p:~p:\n~s", [L, C, Err]));
return_error({F, L, C}, Err) ->
fail(io_lib:format("In ~s at ~p:~p:\n~s", [F, L, C, Err])).
-spec bad_expr_err(string(), so_syntax:expr()) -> so_parse_lib:parser(none()).
-spec ret_doc_err(ann(), prettypr:document()) -> aeso_parse_lib:parser(none()).
ret_doc_err(Ann, Doc) ->
return_error(ann_pos(Ann), prettypr:format(Doc)).
-spec bad_expr_err(string(), aeso_syntax:expr()) -> aeso_parse_lib:parser(none()).
bad_expr_err(Reason, E) ->
ret_doc_err(get_ann(E),
prettypr:sep([prettypr:text(Reason ++ ":"),
prettypr:nest(2, so_pretty:expr(E))])).
prettypr:nest(2, aeso_pretty:expr(E))])).
%% -- Helper functions -------------------------------------------------------
@ -697,29 +556,17 @@ expand_includes(AST, Included, Opts) ->
|| File <- lists:usort(auto_imports(AST)) ] ++ AST,
expand_includes(AST1, Included, [], Opts).
expand_includes([], Included, Acc, Opts) ->
case lists:member(keep_included, Opts) of
false ->
{ok, lists:reverse(Acc)};
true ->
{ok, {lists:reverse(Acc), Included}}
end;
expand_includes([], _Included, Acc, _Opts) ->
{ok, lists:reverse(Acc)};
expand_includes([{include, Ann, {string, _SAnn, File}} | AST], Included, Acc, Opts) ->
case get_include_code(File, Ann, Opts) of
{ok, AbsDir, Code} ->
{ok, Code} ->
Hashed = hash_include(File, Code),
case sets:is_element(Hashed, Included) of
false ->
SrcFile = proplists:get_value(src_file, Opts, no_file),
IncludeType = case proplists:get_value(file, Ann) of
SrcFile -> direct;
_ -> indirect
end,
Opts1 = lists:keystore(src_file, 1, Opts, {src_file, File}),
Opts2 = lists:keystore(src_dir, 1, Opts1, {src_dir, AbsDir}),
Opts3 = lists:keystore(include_type, 1, Opts2, {include_type, IncludeType}),
Included1 = sets:add_element(Hashed, Included),
case parse_and_scan(file(), Code, Opts3) of
case parse_and_scan(file(), Code, Opts1) of
{ok, AST1} ->
expand_includes(AST1 ++ AST, Included1, Acc, Opts);
Err = {error, _} ->
@ -737,74 +584,31 @@ expand_includes([E | AST], Included, Acc, Opts) ->
read_file(File, Opts) ->
case proplists:get_value(include, Opts, {explicit_files, #{}}) of
{file_system, Paths} ->
lists:foldr(fun(Path, {error, _}) -> read_file_(Path, File);
(_Path, OK) -> OK end, {error, not_found}, Paths);
CandidateNames = [ filename:join(Dir, File) || Dir <- Paths ],
lists:foldr(fun(F, {error, _}) -> file:read_file(F);
(_F, OK) -> OK end, {error, not_found}, CandidateNames);
{explicit_files, Files} ->
case maps:get(binary_to_list(File), Files, not_found) of
not_found -> {error, not_found};
Src -> {ok, File, Src}
end;
escript ->
try
Escript = escript:script_name(),
{ok, Sections} = escript:extract(Escript, []),
Archive = proplists:get_value(archive, Sections),
FileName = binary_to_list(filename:join([sophia, priv, stdlib, File])),
case zip:extract(Archive, [{file_list, [FileName]}, memory]) of
{ok, [{_, Src}]} -> {ok, escript, Src};
_ -> {error, not_found}
end
catch _:_ ->
{error, not_found}
Src -> {ok, Src}
end
end.
read_file_(Path, File) ->
AbsFile = filename:join(Path, File),
case file:read_file(AbsFile) of
{ok, Bin} -> {ok, so_utils:canonical_dir(filename:dirname(AbsFile)), Bin};
Err -> Err
end.
stdlib_options() ->
StdLibDir = so_stdlib:stdlib_include_path(),
case filelib:is_dir(StdLibDir) of
true -> [{include, {file_system, [StdLibDir]}}];
false -> [{include, escript}]
end.
[{include, {file_system, [aeso_stdlib:stdlib_include_path()]}}].
get_include_code(File, Ann, Opts) ->
%% Temporarily extend include paths with the directory of the current file
Opts1 = include_current_file_dir(Opts, Ann),
case {read_file(File, Opts1), read_file(File, stdlib_options())} of
{{ok, Dir, Bin}, {ok, _}} ->
case filename:basename(File) == File of
true -> { error
, fail( ann_pos(Ann)
, "Illegal redefinition of standard library " ++ binary_to_list(File))};
%% If a path is provided then the stdlib takes lower priority
false -> {ok, Dir, binary_to_list(Bin)}
end;
{_, {ok, _, Bin}} ->
{ok, stdlib, binary_to_list(Bin)};
{{ok, Dir, Bin}, _} ->
{ok, Dir, binary_to_list(Bin)};
case {read_file(File, Opts), read_file(File, stdlib_options())} of
{{ok, _}, {ok,_ }} ->
return_error(ann_pos(Ann), "Illegal redefinition of standard library " ++ File);
{_, {ok, Bin}} ->
{ok, binary_to_list(Bin)};
{{ok, Bin}, _} ->
{ok, binary_to_list(Bin)};
{_, _} ->
{error, {ann_pos(Ann), include_error, File}}
end.
include_current_file_dir(Opts, Ann) ->
case {proplists:get_value(dir, Ann, undefined),
proplists:get_value(include, Opts, undefined)} of
{undefined, _} -> Opts;
{CurrDir, {file_system, Paths}} ->
case lists:member(CurrDir, Paths) of
false -> [{include, {file_system, [CurrDir | Paths]}} | Opts];
true -> Opts
end;
{_, _} -> Opts
end.
-spec hash_include(string() | binary(), string()) -> include_hash().
hash_include(File, Code) when is_binary(File) ->
hash_include(binary_to_list(File), Code);
@ -818,7 +622,3 @@ auto_imports(L) when is_list(L) ->
auto_imports(T) when is_tuple(T) ->
auto_imports(tuple_to_list(T));
auto_imports(_) -> [].
any_bytes({id, Ann, "bytes"}) -> {bytes_t, Ann, any};
any_bytes({app_t, _, {id, Ann, "bytes"}, []}) -> {bytes_t, Ann, any};
any_bytes(Type) -> Type.

View File

@ -1,13 +1,11 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc Pretty printer for Sophia.
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(so_pretty).
-vsn("9.0.0").
-module(aeso_pretty).
-import(prettypr, [text/1, sep/1, above/2, beside/2, nest/2, empty/0]).
@ -15,8 +13,6 @@
-export_type([options/0]).
-include("so_utils.hrl").
-type doc() :: prettypr:document().
-type options() :: [{indent, non_neg_integer()} | show_generated].
@ -26,11 +22,11 @@
%% -- Options ----------------------------------------------------------------
-define(so_pretty_opts, so_pretty_opts).
-define(aeso_pretty_opts, aeso_pretty_opts).
-spec options() -> options().
options() ->
case get(?so_pretty_opts) of
case get(?aeso_pretty_opts) of
undefined -> [];
Opts -> Opts
end.
@ -47,9 +43,9 @@ indent() -> option(indent, 2).
-spec with_options(options(), fun(() -> A)) -> A.
with_options(Options, Fun) ->
put(?so_pretty_opts, Options),
put(?aeso_pretty_opts, Options),
Res = Fun(),
erase(?so_pretty_opts),
erase(?aeso_pretty_opts),
Res.
%% -- Pretty printing helpers ------------------------------------------------
@ -127,87 +123,63 @@ record(Ds) ->
equals(A, B) -> follow(hsep(A, text("=")), B).
%% typed(A, B) -> A : B.
-spec typed(doc(), so_syntax:type()) -> doc().
-spec typed(doc(), aeso_syntax:type()) -> doc().
typed(A, Type) ->
case so_syntax:get_ann(origin, Type) == system andalso
case aeso_syntax:get_ann(origin, Type) == system andalso
not show_generated() of
true -> A;
false -> follow(hsep(A, text(":")), type(Type))
end.
contract_head(contract_main) -> text("main contract");
contract_head(contract_child) -> text("contract");
contract_head(contract_interface) -> text("contract interface").
%% -- Exports ----------------------------------------------------------------
-spec decls([so_syntax:decl()], options()) -> doc().
-spec decls([aeso_syntax:decl()], options()) -> doc().
decls(Ds, Options) ->
with_options(Options, fun() -> decls(Ds) end).
-spec decls([so_syntax:decl()]) -> doc().
-spec decls([aeso_syntax:decl()]) -> doc().
decls(Ds) -> above([ decl(D) || D <- Ds ]).
-spec decl(so_syntax:decl(), options()) -> doc().
-spec decl(aeso_syntax:decl(), options()) -> doc().
decl(D, Options) ->
with_options(Options, fun() -> decl(D) end).
-spec decl(so_syntax:decl()) -> doc().
decl({Con, Attrs, C, Is, Ds}) when ?IS_CONTRACT_HEAD(Con) ->
Mod = fun({Mod, true}) when Mod == payable ->
text(atom_to_list(Mod));
(_) -> empty() end,
ImplsList = case Is of
[] -> [empty()];
_ -> [text(":"), par(punctuate(text(","), lists:map(fun name/1, Is)), 0)]
end,
block(follow( hsep(lists:map(Mod, Attrs) ++ [contract_head(Con)])
, hsep([name(C)] ++ ImplsList ++ [text("=")])), decls(Ds));
-spec decl(aeso_syntax:decl()) -> doc().
decl({contract, _, C, Ds}) ->
block(follow(text("contract"), hsep(name(C), text("="))), decls(Ds));
decl({namespace, _, C, Ds}) ->
block(follow(text("namespace"), hsep(name(C), text("="))), decls(Ds));
decl({pragma, _, Pragma}) -> pragma(Pragma);
decl({type_decl, _, T, Vars}) -> typedecl(alias_t, T, Vars);
decl({type_def, _, T, Vars, Def}) ->
Kind = element(1, Def),
equals(typedecl(Kind, T, Vars), typedef(Def));
decl({fun_decl, Ann, F, T}) ->
Mod = fun({Mod, true}) when Mod == private; Mod == stateful; Mod == payable ->
text(atom_to_list(Mod));
(_) -> empty() end,
Fun = case so_syntax:get_ann(entrypoint, Ann, false) of
Fun = case aeso_syntax:get_ann(entrypoint, Ann, false) of
true -> text("entrypoint");
false -> text("function")
end,
hsep(lists:map(Mod, Ann) ++ [Fun, typed(name(F), T)]);
hsep(Fun, typed(name(F), T));
decl(D = {letfun, Attrs, _, _, _, _}) ->
Mod = fun({Mod, true}) when Mod == private; Mod == stateful; Mod == payable ->
Mod = fun({Mod, true}) when Mod == private; Mod == stateful ->
text(atom_to_list(Mod));
(_) -> empty() end,
Fun = case so_syntax:get_ann(entrypoint, Attrs, false) of
Fun = case aeso_syntax:get_ann(entrypoint, Attrs, false) of
true -> "entrypoint";
false -> "function"
end,
hsep(lists:map(Mod, Attrs) ++ [letdecl(Fun, D)]);
decl({fun_clauses, Ann, Name, Type, Clauses}) ->
above([ decl(D) || D <- [{fun_decl, Ann, Name, Type} | Clauses] ]);
decl(D = {letval, _, _, _}) -> letdecl("let", D);
decl({block, _, Ds}) ->
above([ decl(D) || D <- Ds ]).
decl(D = {letval, _, _, _, _}) -> letdecl("let", D).
-spec pragma(so_syntax:pragma()) -> doc().
pragma({compiler, Op, Ver}) ->
text("@compiler " ++ atom_to_list(Op) ++ " " ++ string:join([integer_to_list(N) || N <- Ver], ".")).
-spec expr(so_syntax:expr(), options()) -> doc().
-spec expr(aeso_syntax:expr(), options()) -> doc().
expr(E, Options) ->
with_options(Options, fun() -> expr(E) end).
-spec expr(so_syntax:expr()) -> doc().
-spec expr(aeso_syntax:expr()) -> doc().
expr(E) -> expr_p(0, E).
%% -- Not exported -----------------------------------------------------------
-spec name(so_syntax:id() | so_syntax:qid() | so_syntax:con() | so_syntax:qcon() | so_syntax:tvar()) -> doc().
-spec name(aeso_syntax:id() | aeso_syntax:qid() | aeso_syntax:con() | aeso_syntax:qcon() | aeso_syntax:tvar()) -> doc().
name({id, _, Name}) -> text(Name);
name({con, _, Name}) -> text(Name);
name({qid, _, Names}) -> text(string:join(Names, "."));
@ -215,22 +187,20 @@ name({qcon, _, Names}) -> text(string:join(Names, "."));
name({tvar, _, Name}) -> text(Name);
name({typed, _, Name, _}) -> name(Name).
-spec letdecl(string(), so_syntax:letbind()) -> doc().
letdecl(Let, {letval, _, P, E}) ->
block_expr(0, hsep([text(Let), expr(P), text("=")]), E);
letdecl(Let, {letfun, _, F, Args, T, [GuardedBody]}) ->
beside(hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T)]), guarded_body(GuardedBody, "="));
letdecl(Let, {letfun, _, F, Args, T, GuardedBodies}) ->
block(hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T)]), above(lists:map(fun(GB) -> guarded_body(GB, "=") end, GuardedBodies))).
-spec letdecl(string(), aeso_syntax:letbind()) -> doc().
letdecl(Let, {letval, _, F, T, E}) ->
block_expr(0, hsep([text(Let), typed(name(F), T), text("=")]), E);
letdecl(Let, {letfun, _, F, Args, T, E}) ->
block_expr(0, hsep([text(Let), typed(beside(name(F), args(Args)), T), text("=")]), E).
-spec args([so_syntax:arg()]) -> doc().
-spec args([aeso_syntax:arg()]) -> doc().
args(Args) ->
tuple(lists:map(fun arg/1, Args)).
-spec arg(so_syntax:arg()) -> doc().
-spec arg(aeso_syntax:arg()) -> doc().
arg({arg, _, X, T}) -> typed(name(X), T).
-spec typedecl(alias_t | record_t | variant_t, so_syntax:id(), [so_syntax:tvar()]) -> doc().
-spec typedecl(alias_t | record_t | variant_t, aeso_syntax:id(), [aeso_syntax:tvar()]) -> doc().
typedecl(Kind, T, Vars) ->
KW = case Kind of
alias_t -> text("type");
@ -243,28 +213,26 @@ typedecl(Kind, T, Vars) ->
tuple(lists:map(fun name/1, Vars)))
end.
-spec typedef(so_syntax:typedef()) -> doc().
-spec typedef(aeso_syntax:typedef()) -> doc().
typedef({alias_t, Type}) -> type(Type);
typedef({record_t, Fields}) ->
record(lists:map(fun field_t/1, Fields));
typedef({variant_t, Constructors}) ->
par(punctuate(text(" |"), lists:map(fun constructor_t/1, Constructors))).
-spec constructor_t(so_syntax:constructor_t()) -> doc().
-spec constructor_t(aeso_syntax:constructor_t()) -> doc().
constructor_t({constr_t, _, C, []}) -> name(C);
constructor_t({constr_t, _, C, Args}) -> beside(name(C), args_type(Args)).
-spec field_t(so_syntax:field_t()) -> doc().
-spec field_t(aeso_syntax:field_t()) -> doc().
field_t({field_t, _, Name, Type}) ->
typed(name(Name), Type).
-spec type(so_syntax:type(), options()) -> doc().
-spec type(aeso_syntax:type(), options()) -> doc().
type(Type, Options) ->
with_options(Options, fun() -> type(Type) end).
-spec type(so_syntax:type()) -> doc().
type(F = {fun_t, _, _, var_args, _}) ->
type(setelement(4, F, [var_args]));
-spec type(aeso_syntax:type()) -> doc().
type({fun_t, _, Named, Args, Ret}) ->
follow(hsep(args_type(Named ++ Args), text("=>")), type(Ret));
type({type_sig, _, Named, Args, Ret}) ->
@ -277,13 +245,9 @@ type({tuple_t, _, Args}) ->
tuple_type(Args);
type({args_t, _, Args}) ->
args_type(Args);
type({bytes_t, _, any}) -> text("bytes()");
type({bytes_t, _, '_'}) -> text("bytes(_)");
type({bytes_t, _, fixed}) -> text("bytes(_)");
type({bytes_t, _, any}) -> text("bytes(_)");
type({bytes_t, _, Len}) ->
text(lists:concat(["bytes(", Len, ")"]));
type({if_t, _, Id, Then, Else}) ->
beside(text("if"), args_type([Id, Then, Else]));
type({named_arg_t, _, Name, Type, _Default}) ->
%% Drop the default value
%% follow(hsep(typed(name(Name), Type), text("=")), expr(Default));
@ -294,15 +258,13 @@ type(T = {id, _, _}) -> name(T);
type(T = {qid, _, _}) -> name(T);
type(T = {con, _, _}) -> name(T);
type(T = {qcon, _, _}) -> name(T);
type(T = {tvar, _, _}) -> name(T);
type(T = {tvar, _, _}) -> name(T).
type(var_args) -> text("var_args").
-spec args_type([so_syntax:type()]) -> doc().
-spec args_type([aeso_syntax:type()]) -> doc().
args_type(Args) ->
tuple(lists:map(fun type/1, Args)).
-spec tuple_type([so_syntax:type()]) -> doc().
-spec tuple_type([aeso_syntax:type()]) -> doc().
tuple_type([]) ->
text("unit");
tuple_type(Factors) ->
@ -312,15 +274,16 @@ tuple_type(Factors) ->
, text(")")
]).
-spec expr_p(integer(), so_syntax:arg_expr()) -> doc().
expr_p(P, {letpat, _, Id, Pat}) ->
paren(P > 100, follow(hsep(expr(Id), text("=")), expr(Pat)));
expr_p(P, {named_arg, _, Name, E}) ->
paren(P > 100, follow(hsep(expr(Name), text("=")), expr(E)));
-spec arg_expr(aeso_syntax:arg_expr()) -> doc().
arg_expr({named_arg, _, Name, E}) ->
follow(hsep(expr(Name), text("=")), expr(E));
arg_expr(E) -> expr(E).
-spec expr_p(integer(), aeso_syntax:expr()) -> doc().
expr_p(P, {lam, _, Args, E}) ->
paren(P > 100, follow(hsep(args(Args), text("=>")), expr_p(100, E)));
expr_p(P, If = {'if', Ann, Cond, Then, Else}) ->
Format = so_syntax:get_ann(format, If),
Format = aeso_syntax:get_ann(format, If),
if Format == '?:' ->
paren(P > 100,
follow(expr_p(200, Cond),
@ -337,8 +300,6 @@ expr_p(_, {tuple, _, Es}) ->
tuple(lists:map(fun expr/1, Es));
expr_p(_, {list, _, Es}) ->
list(lists:map(fun expr/1, Es));
expr_p(_, {list_comp, _, E, Binds}) ->
list([follow(expr(E), hsep(text("|"), par(punctuate(text(","), lists:map(fun lc_bind/1, Binds)), 0)), 0)]);
expr_p(_, {record, _, Fs}) ->
record(lists:map(fun field/1, Fs));
expr_p(_, {map, Ann, KVs}) ->
@ -363,7 +324,7 @@ expr_p(P, {assign, _, LV, E}) ->
expr_p(_, {app, _, {'..', _}, [A, B]}) ->
list([infix(0, '..', A, B)]);
expr_p(P, E = {app, _, F = {Op, _}, Args}) when is_atom(Op) ->
case {so_syntax:get_ann(format, E), Args} of
case {aeso_syntax:get_ann(format, E), Args} of
{infix, [A, B]} -> infix(P, Op, A, B);
{prefix, [A]} -> prefix(P, Op, A);
_ -> app(P, F, Args)
@ -374,7 +335,7 @@ expr_p(P, {app, _, F, Args}) ->
app(P, F, Args);
%% -- Constants
expr_p(_, E = {int, _, N}) ->
S = case so_syntax:get_ann(format, E) of
S = case aeso_syntax:get_ann(format, E) of
hex -> "0x" ++ integer_to_list(N, 16);
_ -> integer_to_list(N)
end,
@ -389,23 +350,16 @@ expr_p(_, {Type, _, Bin})
when Type == account_pubkey;
Type == contract_pubkey;
Type == oracle_pubkey;
Type == oracle_query_id;
Type == signature ->
text(binary_to_list(gmser_api_encoder:encode(Type, Bin)));
Type == oracle_query_id ->
text(binary_to_list(aeser_api_encoder:encode(Type, Bin)));
expr_p(_, {string, _, <<>>}) -> text("\"\"");
expr_p(_, {string, _, S}) ->
text(io_lib:format("\"~s\"", [binary_to_list(S)]));
expr_p(_, {string, _, S}) -> term(binary_to_list(S));
expr_p(_, {char, _, C}) ->
case C of
$' -> text("'\\''");
$" -> text("'\"'");
_ when C < 16#80 ->
S = lists:flatten(io_lib:format("~p", [[C]])),
text("'" ++ tl(lists:droplast(S)) ++ "'");
_ ->
S = lists:flatten(
io_lib:format("'~ts'", [list_to_binary(so_scan:utf8_encode([C]))])),
text(S)
_ -> S = lists:flatten(io_lib:format("~p", [[C]])),
text("'" ++ tl(lists:droplast(S)) ++ "'")
end;
%% -- Names
expr_p(_, E = {id, _, _}) -> name(E);
@ -421,40 +375,27 @@ stmt_p({'if', _, Cond, Then}) ->
block_expr(200, beside(text("if"), paren(expr(Cond))), Then);
stmt_p({elif, _, Cond, Then}) ->
block_expr(200, beside(text("elif"), paren(expr(Cond))), Then);
stmt_p({'else', Else}) ->
stmt_p({else, Else}) ->
HideGenerated = not show_generated(),
case so_syntax:get_ann(origin, Else) of
case aeso_syntax:get_ann(origin, Else) of
system when HideGenerated -> empty();
_ -> block_expr(200, text("else"), Else)
end.
lc_bind({comprehension_bind, P, E}) ->
follow(hsep(expr(P), text("<-")), expr(E));
lc_bind({comprehension_if, _, E}) ->
beside([text("if("), expr(E), text(")")]);
lc_bind(Let) ->
letdecl("let", Let).
-spec bin_prec(so_syntax:bin_op()) -> {integer(), integer(), integer()}.
-spec bin_prec(aeso_syntax:bin_op()) -> {integer(), integer(), integer()}.
bin_prec('..') -> { 0, 0, 0}; %% Always printed inside '[ ]'
bin_prec('=') -> { 0, 0, 0}; %% Always printed inside '[ ]'
bin_prec('@') -> { 0, 0, 0}; %% Only in error messages
bin_prec('|>') -> {150, 150, 200};
bin_prec('||') -> {200, 300, 200};
bin_prec('&&') -> {300, 325, 300};
bin_prec('bor') -> {325, 350, 325};
bin_prec('bxor') -> {350, 375, 350};
bin_prec('band') -> {375, 400, 375};
bin_prec('&&') -> {300, 400, 300};
bin_prec('<') -> {400, 500, 500};
bin_prec('>') -> {400, 500, 500};
bin_prec('=<') -> {400, 500, 500};
bin_prec('>=') -> {400, 500, 500};
bin_prec('==') -> {400, 500, 500};
bin_prec('!=') -> {400, 500, 500};
bin_prec('++') -> {500, 550, 500};
bin_prec('::') -> {500, 550, 500};
bin_prec('<<') -> {550, 600, 550};
bin_prec('>>') -> {550, 600, 550};
bin_prec('++') -> {500, 600, 500};
bin_prec('::') -> {500, 600, 500};
bin_prec('+') -> {600, 600, 650};
bin_prec('-') -> {600, 600, 650};
bin_prec('*') -> {700, 700, 750};
@ -462,15 +403,14 @@ bin_prec('/') -> {700, 700, 750};
bin_prec(mod) -> {700, 700, 750};
bin_prec('^') -> {750, 750, 800}.
-spec un_prec(so_syntax:un_op()) -> {integer(), integer()}.
-spec un_prec(aeso_syntax:un_op()) -> {integer(), integer()}.
un_prec('-') -> {650, 650};
un_prec('!') -> {800, 800};
un_prec('bnot') -> {850, 850}.
un_prec('!') -> {800, 800}.
equals(Ann, A, B) ->
{app, [{format, infix} | Ann], {'=', Ann}, [A, B]}.
-spec infix(integer(), so_syntax:bin_op(), so_syntax:expr(), so_syntax:expr()) -> doc().
-spec infix(integer(), aeso_syntax:bin_op(), aeso_syntax:expr(), aeso_syntax:expr()) -> doc().
infix(P, Op, A, B) ->
{Top, L, R} = bin_prec(Op),
paren(P > Top,
@ -484,7 +424,7 @@ prefix(P, Op, A) ->
app(P, F, Args) ->
paren(P > 900,
beside(expr_p(900, F),
tuple(lists:map(fun expr/1, Args)))).
tuple(lists:map(fun arg_expr/1, Args)))).
field({field, _, LV, E}) ->
follow(hsep(lvalue(LV), text("=")), expr(E));
@ -504,18 +444,8 @@ elim1(Proj={proj, _, _}) -> beside(text("."), elim(Proj));
elim1(Get={map_get, _, _}) -> elim(Get);
elim1(Get={map_get, _, _, _}) -> elim(Get).
alt({'case', _, Pat, [GuardedBody]}) ->
beside(expr(Pat), guarded_body(GuardedBody, "=>"));
alt({'case', _, Pat, GuardedBodies}) ->
block(expr(Pat), above(lists:map(fun(GB) -> guarded_body(GB, "=>") end, GuardedBodies))).
guarded_body({guarded, _, Guards, Body}, Then) ->
block_expr(0, hsep(guards(Guards), text(Then)), Body).
guards([]) ->
text("");
guards(Guards) ->
hsep([text(" |"), par(punctuate(text(","), lists:map(fun expr/1, Guards)), 0)]).
alt({'case', _, Pat, Body}) ->
block_expr(0, hsep(expr_p(500, Pat), text("=>")), Body).
block_expr(_, Header, {block, _, Ss}) ->
block(Header, statements(Ss));
@ -525,16 +455,19 @@ block_expr(P, Header, E) ->
statements(Stmts) ->
above([ statement(S) || S <- Stmts ]).
statement(S = {letval, _, _, _}) -> letdecl("let", S);
statement(S = {letval, _, _, _, _}) -> letdecl("let", S);
statement(S = {letfun, _, _, _, _, _}) -> letdecl("let", S);
statement(E) -> expr(E).
get_elifs(Expr) -> get_elifs(Expr, []).
get_elifs(If = {'if', Ann, Cond, Then, Else}, Elifs) ->
case so_syntax:get_ann(format, If) of
case aeso_syntax:get_ann(format, If) of
elif -> get_elifs(Else, [{elif, Ann, Cond, Then} | Elifs]);
_ -> {lists:reverse(Elifs), If}
end;
get_elifs(Else, Elifs) -> {lists:reverse(Elifs), {'else', Else}}.
get_elifs(Else, Elifs) -> {lists:reverse(Elifs), {else, Else}}.
fmt(Fmt, Args) -> text(lists:flatten(io_lib:format(Fmt, Args))).
term(X) -> fmt("~p", [X]).

View File

@ -1,42 +1,33 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc The Sophia lexer.
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(so_scan).
-vsn("9.0.0").
-module(aeso_scan).
-export([scan/1, utf8_encode/1]).
-export([scan/1]).
-import(so_scan_lib, [token/1, token/2, symbol/0, skip/0,
-import(aeso_scan_lib, [token/1, token/2, symbol/0, skip/0,
override/2, push/2, pop/1]).
lexer() ->
Number = fun(Digit) -> [Digit, "+(_", Digit, "+)*"] end,
DIGIT = "[0-9]",
HEXDIGIT = "[0-9a-fA-F]",
LOWER = "[a-z_]",
UPPER = "[A-Z]",
CON = [UPPER, "[a-zA-Z0-9_]*"],
INT = Number(DIGIT),
HEX = ["0x", Number(HEXDIGIT)],
BYTES = ["#", Number(HEXDIGIT)],
INT = [DIGIT, "+"],
HEX = ["0x", HEXDIGIT, "+"],
BYTES = ["#", HEXDIGIT, "+"],
WS = "[\\000-\\ ]+",
ID = [LOWER, "[a-zA-Z0-9_']*"],
TVAR = ["'", ID],
QID = ["(", CON, "\\.)+", ID],
QCON = ["(", CON, "\\.)+", CON],
OP = "[=!<>+\\-*/:&|?~@^]+",
%% Five cases for a character
%% * 1 7-bit ascii, not \ or '
%% * 2-4 8-bit values (UTF8)
%% * \ followed by a known modifier [aernrtv]
%% * \xhh
%% * \x{hhh...}
CHAR = "'(([\\x00-\\x26\\x28-\\x5b\\x5d-\\x7f])|([\\x00-\\xff][\\x80-\\xff]{1,3})|(\\\\[befnrtv'\\\\])|(\\\\x[0-9a-fA-F]{2,2})|(\\\\x\\{[0-9a-fA-F]*\\}))'",
CHAR = "'([^'\\\\]|(\\\\.))'",
STRING = "\"([^\"\\\\]|(\\\\.))*\"",
CommentStart = {"/\\*", push(comment, skip())},
@ -46,9 +37,7 @@ lexer() ->
, {"[^/*]+|[/*]", skip()} ],
Keywords = ["contract", "include", "let", "switch", "type", "record", "datatype", "if", "elif", "else", "function",
"stateful", "payable", "true", "false", "mod", "public", "entrypoint", "private", "indexed", "namespace",
"interface", "main", "using", "as", "for", "hiding", "band", "bor", "bxor", "bnot"
],
"stateful", "payable", "true", "false", "mod", "public", "entrypoint", "private", "indexed", "namespace"],
KW = string:join(Keywords, "|"),
Rules =
@ -64,7 +53,7 @@ lexer() ->
, {CHAR, token(char, fun parse_char/1)}
, {STRING, token(string, fun parse_string/1)}
, {HEX, token(hex, fun parse_hex/1)}
, {INT, token(int, fun parse_int/1)}
, {INT, token(int, fun list_to_integer/1)}
, {BYTES, token(bytes, fun parse_bytes/1)}
%% Identifiers (qualified first!)
@ -81,40 +70,38 @@ lexer() ->
[{code, Rules}, {comment, CommentRules}].
scan(String) ->
Lexer = so_scan_lib:compile(lexer()),
so_scan_lib:string(Lexer, code, String).
Lexer = aeso_scan_lib:compile(lexer()),
aeso_scan_lib:string(Lexer, code, String).
%% -- Helpers ----------------------------------------------------------------
parse_string([$" | Chars]) ->
unicode:characters_to_nfc_binary(unescape(Chars)).
unescape(Chars).
parse_char([$' | Chars]) ->
case unicode:characters_to_nfc_list(unescape($', Chars, [])) of
[Char] -> Char;
_Bad -> {error, "Bad character literal: '" ++ Chars}
end.
utf8_encode(Cs) ->
binary_to_list(unicode:characters_to_binary(Cs)).
unescape(Str) -> unescape($", Str, []).
unescape(Delim, [Delim], Acc) ->
list_to_binary(lists:reverse(Acc));
unescape(Delim, [$\\, $x, ${ | Chars ], Acc) ->
{Ds, [_ | Cs]} = lists:splitwith(fun($}) -> false ; (_) -> true end, Chars),
C = list_to_integer(Ds, 16),
Utf8Cs = binary_to_list(unicode:characters_to_binary([C])),
unescape(Delim, Cs, [Utf8Cs | Acc]);
unescape(Delim, [$\\, $x, D1, D2 | Chars ], Acc) ->
C = list_to_integer([D1, D2], 16),
Utf8Cs = binary_to_list(unicode:characters_to_binary([C])),
unescape(Delim, Chars, [Utf8Cs | Acc]);
unescape(Delim, [$\\, Code | Chars], Acc) ->
Ok = fun(C) -> unescape(Delim, Chars, [C | Acc]) end,
parse_char([$', $\\, Code, $']) ->
case Code of
Delim -> Ok(Delim);
$' -> $';
$\\ -> $\\;
$b -> $\b;
$e -> $\e;
$f -> $\f;
$n -> $\n;
$r -> $\r;
$t -> $\t;
$v -> $\v;
_ -> {error, "Bad control sequence: \\" ++ [Code]}
end;
parse_char([$', C, $']) -> C.
unescape(Str) -> unescape(Str, []).
%% TODO: numeric escapes
unescape([$"], Acc) ->
list_to_binary(lists:reverse(Acc));
unescape([$\\, Code | Chars], Acc) ->
Ok = fun(C) -> unescape(Chars, [C | Acc]) end,
case Code of
$" -> Ok($");
$\\ -> Ok($\\);
$b -> Ok($\b);
$e -> Ok($\e);
@ -125,21 +112,13 @@ unescape(Delim, [$\\, Code | Chars], Acc) ->
$v -> Ok($\v);
_ -> error("Bad control sequence: \\" ++ [Code]) %% TODO
end;
unescape(Delim, [C | Chars], Acc) ->
unescape(Delim, Chars, [C | Acc]).
unescape([C | Chars], Acc) ->
unescape(Chars, [C | Acc]).
strip_underscores(S) ->
lists:filter(fun(C) -> C /= $_ end, S).
parse_hex("0x" ++ Chars) -> list_to_integer(Chars, 16).
parse_hex("0x" ++ S) ->
list_to_integer(strip_underscores(S), 16).
parse_int(S) ->
list_to_integer(strip_underscores(S)).
parse_bytes("#" ++ S0) ->
S = strip_underscores(S0),
N = list_to_integer(S, 16),
Digits = (length(S) + 1) div 2,
parse_bytes("#" ++ Chars) ->
N = list_to_integer(Chars, 16),
Digits = (length(Chars) + 1) div 2,
<<N:Digits/unit:8>>.

View File

@ -1,12 +1,10 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc A customisable lexer.
%%% @end
%%%-------------------------------------------------------------------
-module(so_scan_lib).
-vsn("9.0.0").
-module(aeso_scan_lib).
-export([compile/1, string/3,
token/1, token/2, symbol/0, skip/0,

View File

@ -1,18 +1,17 @@
%%%-------------------------------------------------------------------
%%% @author Radosław Rowicki
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2019, Aeternity Anstalt
%%% @doc
%%% Standard library for Sophia
%%% @end
%%% Created : 6 July 2019
%%%
%%%-------------------------------------------------------------------
-module(so_stdlib).
-vsn("9.0.0").
-module(aeso_stdlib).
-export([stdlib_include_path/0]).
stdlib_include_path() ->
{file, BEAM} = code:is_loaded(?MODULE),
filename:join(filename:dirname(filename:dirname(BEAM)), "priv/stdlib").
filename:join([code:priv_dir(aesophia), "stdlib"]).

View File

@ -1,21 +1,19 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc Sophia abstract syntax types.
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(so_syntax).
-vsn("9.0.0").
-module(aeso_syntax).
-export([get_ann/1, get_ann/2, get_ann/3, set_ann/2, qualify/2]).
-export_type([ann_file/0, ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
-export_type([ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
-export_type([name/0, id/0, con/0, qid/0, qcon/0, tvar/0, op/0]).
-export_type([bin_op/0, un_op/0]).
-export_type([decl/0, letbind/0, typedef/0, pragma/0, fundecl/0]).
-export_type([decl/0, letbind/0, typedef/0]).
-export_type([arg/0, field_t/0, constructor_t/0, named_arg_t/0]).
-export_type([type/0, constant/0, expr/0, arg_expr/0, field/1, stmt/0, alt/0, lvalue/0, elim/0, pat/0]).
-export_type([ast/0]).
@ -26,10 +24,8 @@
-type ann_col() :: integer().
-type ann_origin() :: system | user.
-type ann_format() :: '?:' | hex | infix | prefix | elif.
-type ann_file() :: string() | no_file.
-type ann() :: [ {file, ann_file()} | {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()}
| stateful | private | payable | main | interface | entrypoint].
-type ann() :: [{line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()} | stateful | private].
-type name() :: string().
-type id() :: {id, ann(), name()}.
@ -38,39 +34,16 @@
-type qcon() :: {qcon, ann(), [name()]}.
-type tvar() :: {tvar, ann(), name()}.
-type namespace_alias() :: none | con().
-type namespace_parts() :: none | {for, [id()]} | {hiding, [id()]}.
-type decl() :: {contract_main, ann(), con(), [con()], [decl()]}
| {contract_child, ann(), con(), [con()], [decl()]}
| {contract_interface, ann(), con(), [con()], [decl()]}
-type decl() :: {contract, ann(), con(), [decl()]}
| {namespace, ann(), con(), [decl()]}
| {include, ann(), {string, ann(), string()}}
| {pragma, ann(), pragma()}
| {type_decl, ann(), id(), [tvar()]} % Only for error msgs
| {type_decl, ann(), id(), [tvar()]}
| {type_def, ann(), id(), [tvar()], typedef()}
| {fun_clauses, ann(), id(), type(), [letfun() | fundecl()]}
| {block, ann(), [decl()]}
| {using, ann(), con(), namespace_alias(), namespace_parts()}
| fundecl()
| letfun()
| letval(). % Only for error msgs
-type compiler_version() :: [non_neg_integer()].
-type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}.
-type guard() :: expr().
-type guarded_expr() :: {guarded, ann(), [guard()], expr()}.
-type letval() :: {letval, ann(), pat(), expr()}.
-type letfun() :: {letfun, ann(), id(), [pat()], type(), [guarded_expr(),...]}.
-type letpat() :: {letpat, ann(), id(), pat()}.
-type fundecl() :: {fun_decl, ann(), id(), type()}.
| {fun_decl, ann(), id(), type()}
| letbind().
-type letbind()
:: letfun()
| letval().
:: {letval, ann(), id(), type(), expr()}
| {letfun, ann(), id(), [arg()], type(), expr()}.
-type arg() :: {arg, ann(), id(), type()}.
@ -102,7 +75,6 @@
| {contract_pubkey, ann(), binary()}
| {oracle_pubkey, ann(), binary()}
| {oracle_query_id, ann(), binary()}
| {signature, ann(), binary()}
| {string, ann(), binary()}
| {char, ann(), integer()}.
@ -110,8 +82,8 @@
-type bin_op() :: '+' | '-' | '*' | '/' | mod | '^'
| '++' | '::' | '<' | '>' | '=<' | '>=' | '==' | '!='
| '||' | '&&' | '..' | 'band' | 'bor' | 'bxor' | '>>' | '<<' | '|>'.
-type un_op() :: '-' | '!' | 'bnot'.
| '||' | '&&' | '..'.
-type un_op() :: '-' | '!'.
-type expr()
:: {lam, ann(), [arg()], expr()}
@ -123,20 +95,18 @@
| {list, ann(), [expr()]}
| {list_comp, ann(), expr(), [comprehension_exp()]}
| {typed, ann(), expr(), type()}
| {record_or_map(), ann(), [field(expr())]}
| {record_or_map(), ann(), expr(), [field(expr())]} %% record/map update
| {record, ann(), [field(expr())]}
| {record, ann(), expr(), [field(expr())]} %% record update
| {map, ann(), expr(), [field(expr())]} %% map update
| {map, ann(), [{expr(), expr()}]}
| {map_get, ann(), expr(), expr()}
| {map_get, ann(), expr(), expr(), expr()}
| {block, ann(), [stmt()]}
| {op(), ann()}
| id() | qid() | con() | qcon()
| constant()
| letpat().
| constant().
-type record_or_map() :: record | map | record_or_map_error.
-type comprehension_exp() :: [ {comprehension_bind, pat(), expr()}
-type comprehension_exp() :: [ {comprehension_bind, id(), expr()}
| {comprehension_if, ann(), expr()}
| letbind() ].
@ -153,7 +123,7 @@
-type stmt() :: letbind()
| expr().
-type alt() :: {'case', ann(), pat(), [guarded_expr(),...]}.
-type alt() :: {'case', ann(), pat(), expr()}.
-type lvalue() :: nonempty_list(elim()).
@ -164,9 +134,7 @@
-type pat() :: {app, ann(), con() | op(), [pat()]}
| {tuple, ann(), [pat()]}
| {list, ann(), [pat()]}
| {typed, ann(), pat(), type()}
| {record, ann(), [field(pat())]}
| letpat()
| constant()
| con()
| id().

View File

@ -1,14 +1,12 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2018, Aeternity Anstalt
%%% @doc
%%% Sophia syntax utilities.
%%% @end
%%%-------------------------------------------------------------------
-module(so_syntax_utils).
-vsn("9.0.0").
-module(aeso_syntax_utils).
-export([used_ids/1, used_ids/2, used_types/2, used/1]).
-export([used_ids/1, used_types/2, used/1]).
-record(alg, {zero, plus, scoped}).
@ -19,41 +17,39 @@
-type kind() :: decl | type | bind_type | expr | bind_expr.
-spec fold(alg(A), fun((kind(), _) -> A), kind(), E | [E]) -> A
when E :: so_syntax:decl()
| so_syntax:typedef()
| so_syntax:field_t()
| so_syntax:constructor_t()
| so_syntax:type()
| so_syntax:expr()
| so_syntax:pat()
| so_syntax:arg()
| so_syntax:alt()
| so_syntax:elim()
| so_syntax:arg_expr()
| so_syntax:field(so_syntax:expr())
| so_syntax:stmt().
when E :: aeso_syntax:decl()
| aeso_syntax:typedef()
| aeso_syntax:field_t()
| aeso_syntax:constructor_t()
| aeso_syntax:type()
| aeso_syntax:expr()
| aeso_syntax:pat()
| aeso_syntax:arg()
| aeso_syntax:alt()
| aeso_syntax:elim()
| aeso_syntax:arg_expr()
| aeso_syntax:field(aeso_syntax:expr())
| aeso_syntax:stmt().
fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
ExprKind = if K == bind_expr -> bind_expr; true -> expr end,
TypeKind = if K == bind_type -> bind_type; true -> type end,
Sum = fun(Xs) -> lists:foldl(Plus, Zero, Xs) end,
Same = fun(A) -> fold(Alg, Fun, K, A) end,
Decl = fun(D) -> fold(Alg, Fun, decl, D) end,
Type = fun(T) -> fold(Alg, Fun, TypeKind, T) end,
Expr = fun(E) -> fold(Alg, Fun, ExprKind, E) end,
Type = fun(T) -> fold(Alg, Fun, type, T) end,
Expr = fun(E) -> fold(Alg, Fun, expr, E) end,
BindExpr = fun(P) -> fold(Alg, Fun, bind_expr, P) end,
BindType = fun(T) -> fold(Alg, Fun, bind_type, T) end,
Top = Fun(K, X),
Rec = case X of
%% lists (bound things in head scope over tail)
[A | As] -> Scoped(Same(A), Same(As));
[A | As] -> Scoped(Same(A), Same(As));
%% decl()
{contract, _, _, Ds} -> Decl(Ds);
{namespace, _, _, Ds} -> Decl(Ds);
{type_def, _, I, _, D} -> Plus(BindType(I), Decl(D));
{fun_decl, _, _, T} -> Type(T);
{letval, _, P, E} -> Scoped(BindExpr(P), Expr(E));
{letfun, _, F, Xs, T, GEs} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ GEs)]);
{fun_clauses, _, _, T, Cs} -> Sum([Type(T) | [Decl(C) || C <- Cs]]);
{contract, _, _, Ds} -> Decl(Ds);
{namespace, _, _, Ds} -> Decl(Ds);
{type_decl, _, I, _} -> BindType(I);
{type_def, _, I, _, D} -> Plus(BindType(I), Decl(D));
{fun_decl, _, _, T} -> Type(T);
{letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]);
{letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]);
%% typedef()
{alias_t, T} -> Type(T);
{record_t, Fs} -> Type(Fs);
@ -80,8 +76,8 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
Plus(Expr(E), Scoped(BindExpr(I), Expr({list_comp, A, Y, R})));
{list_comp, A, Y, [{comprehension_if, _, E}|R]} ->
Plus(Expr(E), Expr({list_comp, A, Y, R}));
{list_comp, A, Y, [D = {letval, _, Pat, _} | R]} ->
Plus(Decl(D), Scoped(BindExpr(Pat), Expr({list_comp, A, Y, R})));
{list_comp, A, Y, [D = {letval, _, F, _, _} | R]} ->
Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R})));
{list_comp, A, Y, [D = {letfun, _, F, _, _, _} | R]} ->
Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R})));
{typed, _, E, T} -> Plus(Expr(E), Type(T));
@ -92,15 +88,13 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
{map_get, _, A, B} -> Expr([A, B]);
{map_get, _, A, B, C} -> Expr([A, B, C]);
{block, _, Ss} -> Expr(Ss);
{letpat, _, X, P} -> Plus(BindExpr(X), Expr(P));
{guarded, _, Gs, E} -> Expr([E | Gs]);
%% field()
{field, _, LV, E} -> Expr([LV, E]);
{field, _, LV, _, E} -> Expr([LV, E]);
%% arg()
{arg, _, Y, T} -> Plus(BindExpr(Y), Type(T));
%% alt()
{'case', _, P, GEs} -> Scoped(BindExpr(P), Expr(GEs));
{'case', _, P, E} -> Scoped(BindExpr(P), Expr(E));
%% elim()
{proj, _, _} -> Zero;
{map_get, _, E} -> Expr(E);
@ -112,16 +106,8 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
%% Name dependencies
%% Used ids, top level
used_ids(E) ->
used_ids([], E).
%% Used ids, top level or in (current) namespace
used_ids(Ns, E) ->
[ lists:last(Xs) || {{term, Xs}, _} <- used(E), in_ns(Xs, Ns) ].
in_ns([_], _) -> true;
in_ns(Xs, Ns) -> lists:droplast(Xs) == Ns.
[ X || {{term, [X]}, _} <- used(E) ].
used_types([Top] = _CurrentNS, T) ->
F = fun({{type, [X]}, _}) -> [X];
@ -134,7 +120,7 @@ used_types([Top] = _CurrentNS, T) ->
| {type, [string()]}
| {namespace, [string()]}.
-spec entity_alg() -> alg(#{entity() => so_syntax:ann()}).
-spec entity_alg() -> alg(#{entity() => aeso_syntax:ann()}).
entity_alg() ->
IsBound = fun({K, _}) -> lists:member(K, [bound_term, bound_type]) end,
Unbind = fun(bound_term) -> term; (bound_type) -> type end,
@ -149,7 +135,7 @@ entity_alg() ->
, plus = fun maps:merge/2
, scoped = Scoped }.
-spec used(_) -> [{entity(), so_syntax:ann()}].
-spec used(_) -> [{entity(), aeso_syntax:ann()}].
used(D) ->
Kind = fun(expr) -> term;
(bind_expr) -> bound_term;
@ -167,3 +153,4 @@ used(D) ->
(_, _) -> #{}
end, decl, D)),
lists:filter(NotBound, Xs).

View File

@ -1,29 +1,15 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2018, Aeternity Anstalt
%%% @doc
%%% Sophia utility functions.
%%% @end
%%%-------------------------------------------------------------------
-module(so_utils).
-vsn("9.0.0").
-module(aeso_utils).
-export([scc/1, canonical_dir/1]).
-export([scc/1]).
-export_type([graph/1]).
%% -- Simplistic canonical directory
%% Note: no attempts to be 100% complete
canonical_dir(Dir) ->
{ok, Cwd} = file:get_cwd(),
AbsName = filename:absname(Dir),
RelAbsName = filename:join(tl(filename:split(AbsName))),
case filelib:safe_relative_path(RelAbsName, Cwd) of
unsafe -> AbsName;
Simplified -> filename:absname(Simplified, "")
end.
%% -- Topological sort
-type graph(Node) :: #{Node => [Node]}. %% List of incoming edges (dependencies).

113
src/aeso_vm_decode.erl Normal file
View File

@ -0,0 +1,113 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc Decoding aevm and fate data to AST
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(aeso_vm_decode).
-export([ from_aevm/3, from_fate/2 ]).
-include_lib("aebytecode/include/aeb_fate_data.hrl").
address_literal(Type, N) -> {Type, [], <<N:256>>}.
-spec from_aevm(aeb_aevm_data:type(), aeso_syntax:type(), aeb_aevm_data:data()) -> aeso_syntax:expr().
from_aevm(word, {id, _, "address"}, N) -> address_literal(account_pubkey, N);
from_aevm(word, {app_t, _, {id, _, "oracle"}, _}, N) -> address_literal(oracle_pubkey, N);
from_aevm(word, {app_t, _, {id, _, "oracle_query"}, _}, N) -> address_literal(oracle_query_id, N);
from_aevm(word, {con, _, _Name}, N) -> address_literal(contract_pubkey, N);
from_aevm(word, {id, _, "int"}, N) -> <<N1:256/signed>> = <<N:256>>, {int, [], N1};
from_aevm(word, {id, _, "bits"}, N) -> error({todo, bits, N});
from_aevm(word, {id, _, "bool"}, N) -> {bool, [], N /= 0};
from_aevm(word, {bytes_t, _, Len}, Val) when Len =< 32 ->
<<Bytes:Len/unit:8, _/binary>> = <<Val:32/unit:8>>,
{bytes, [], <<Bytes:Len/unit:8>>};
from_aevm({tuple, _}, {bytes_t, _, Len}, Val) ->
{bytes, [], binary:part(<< <<W:32/unit:8>> || W <- tuple_to_list(Val) >>, 0, Len)};
from_aevm(string, {id, _, "string"}, S) -> {string, [], S};
from_aevm({list, VmType}, {app_t, _, {id, _, "list"}, [Type]}, List) ->
{list, [], [from_aevm(VmType, Type, X) || X <- List]};
from_aevm({variant, [[], [VmType]]}, {app_t, _, {id, _, "option"}, [Type]}, Val) ->
case Val of
{variant, 0, []} -> {con, [], "None"};
{variant, 1, [X]} -> {app, [], {con, [], "Some"}, [from_aevm(VmType, Type, X)]}
end;
from_aevm({tuple, VmTypes}, {tuple_t, _, Types}, Val)
when length(VmTypes) == length(Types),
length(VmTypes) == tuple_size(Val) ->
{tuple, [], [from_aevm(VmType, Type, X)
|| {VmType, Type, X} <- lists:zip3(VmTypes, Types, tuple_to_list(Val))]};
from_aevm({tuple, VmTypes}, {record_t, Fields}, Val)
when length(VmTypes) == length(Fields),
length(VmTypes) == tuple_size(Val) ->
{record, [], [ {field, [], [{proj, [], FName}], from_aevm(VmType, FType, X)}
|| {VmType, {field_t, _, FName, FType}, X} <- lists:zip3(VmTypes, Fields, tuple_to_list(Val)) ]};
from_aevm({map, VmKeyType, VmValType}, {app_t, _, {id, _, "map"}, [KeyType, ValType]}, Map)
when is_map(Map) ->
{map, [], [ {from_aevm(VmKeyType, KeyType, Key),
from_aevm(VmValType, ValType, Val)}
|| {Key, Val} <- maps:to_list(Map) ]};
from_aevm({variant, VmCons}, {variant_t, Cons}, {variant, Tag, Args})
when length(VmCons) == length(Cons),
length(VmCons) > Tag ->
VmTypes = lists:nth(Tag + 1, VmCons),
ConType = lists:nth(Tag + 1, Cons),
from_aevm(VmTypes, ConType, Args);
from_aevm(VmTypes, {constr_t, _, Con, Types}, Args)
when length(VmTypes) == length(Types),
length(VmTypes) == length(Args) ->
{app, [], Con, [ from_aevm(VmType, Type, Arg)
|| {VmType, Type, Arg} <- lists:zip3(VmTypes, Types, Args) ]};
from_aevm(_VmType, _Type, _Data) ->
throw(cannot_translate_to_sophia).
-spec from_fate(aeso_syntax:type(), aeb_fate_data:fate_type()) -> aeso_syntax:expr().
from_fate({id, _, "address"}, ?FATE_ADDRESS(Bin)) -> {account_pubkey, [], Bin};
from_fate({app_t, _, {id, _, "oracle"}, _}, ?FATE_ORACLE(Bin)) -> {oracle_pubkey, [], Bin};
from_fate({app_t, _, {id, _, "oracle_query"}, _}, ?FATE_ORACLE_Q(Bin)) -> {oracle_query_id, [], Bin};
from_fate({con, _, _Name}, ?FATE_CONTRACT(Bin)) -> {contract_pubkey, [], Bin};
from_fate({bytes_t, _, N}, ?FATE_BYTES(Bin)) when byte_size(Bin) == N -> {bytes, [], Bin};
from_fate({id, _, "bits"}, ?FATE_BITS(Bin)) -> error({todo, bits, Bin});
from_fate({id, _, "int"}, N) when is_integer(N) -> {int, [], N};
from_fate({id, _, "bool"}, B) when is_boolean(B) -> {bool, [], B};
from_fate({id, _, "string"}, S) when is_binary(S) -> {string, [], S};
from_fate({app_t, _, {id, _, "list"}, [Type]}, List) when is_list(List) ->
{list, [], [from_fate(Type, X) || X <- List]};
from_fate({app_t, _, {id, _, "option"}, [Type]}, Val) ->
case Val of
{variant, [0, 1], 0, {}} -> {con, [], "None"};
{variant, [0, 1], 1, {X}} -> {app, [], {con, [], "Some"}, [from_fate(Type, X)]}
end;
from_fate({tuple_t, _, []}, ?FATE_UNIT) ->
{tuple, [], []};
from_fate({tuple_t, _, Types}, ?FATE_TUPLE(Val))
when length(Types) == tuple_size(Val) ->
{tuple, [], [from_fate(Type, X)
|| {Type, X} <- lists:zip(Types, tuple_to_list(Val))]};
from_fate({record_t, Fields}, ?FATE_TUPLE(Val))
when length(Fields) == tuple_size(Val) ->
{record, [], [ {field, [], [{proj, [], FName}], from_fate(FType, X)}
|| {{field_t, _, FName, FType}, X} <- lists:zip(Fields, tuple_to_list(Val)) ]};
from_fate({app_t, _, {id, _, "map"}, [KeyType, ValType]}, Map)
when is_map(Map) ->
{map, [], [ {from_fate(KeyType, Key),
from_fate(ValType, Val)}
|| {Key, Val} <- maps:to_list(Map) ]};
from_fate({variant_t, Cons}, {variant, Ar, Tag, Args})
when length(Cons) > Tag ->
ConType = lists:nth(Tag + 1, Cons),
Arity = lists:nth(Tag + 1, Ar),
case tuple_to_list(Args) of
ArgList when length(ArgList) == Arity ->
from_fate(ConType, ArgList);
_ -> throw(cannot_translate_to_sophia)
end;
from_fate({constr_t, _, Con, Types}, Args)
when length(Types) == length(Args) ->
{app, [], Con, [ from_fate(Type, Arg)
|| {Type, Arg} <- lists:zip(Types, Args) ]};
from_fate(_Type, _Data) ->
throw(cannot_translate_to_sophia).

View File

@ -1,13 +1,14 @@
{application, sophia,
[{description, "Compiler for Sophia language"},
{vsn, "9.0.0"},
{application, aesophia,
[{description, "Contract Language for aeternity"},
{vsn, "4.0.0-rc1"},
{registered, []},
{applications,
[kernel,
stdlib,
jsx,
syntax_tools,
gmbytecode,
getopt,
aebytecode,
eblake2
]},
{env,[]},

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,526 +0,0 @@
%%%-------------------------------------------------------------------
%%% @author Happi (Erik Stenman)
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc
%%% Compiler from Sophia language to FATE.
%%% @end
%%%-------------------------------------------------------------------
-module(so_compiler).
-vsn("9.0.0").
-export([ file/1
, file/2
, from_string/2
, check_call/4
, decode_value/4
, encode_value/4
, create_calldata/3
, create_calldata/4
, version/0
, numeric_version/0
, to_sophia_value/4
, to_sophia_value/5
, decode_calldata/3
, decode_calldata/4
, parse/2
, add_include_path/2
, validate_byte_code/3
]).
-include_lib("gmbytecode/include/gmb_opcodes.hrl").
-include("so_utils.hrl").
-type option() :: pp_sophia_code
| pp_ast
| pp_types
| pp_typed_ast
| pp_assembler
| no_code
| keep_included
| debug_mode
| {include, {file_system, [string()]} |
{explicit_files, #{string() => binary()}}}
| {src_file, string()}
| {src_dir, string()}
| {aci, so_aci:aci_type()}.
-type options() :: [option()].
-export_type([ option/0
, options/0
]).
-spec version() -> {ok, binary()} | {error, term()}.
version() ->
case lists:keyfind(sophia, 1, application:loaded_applications()) of
false ->
case application:load(sophia) of
ok ->
case application:get_key(sophia, vsn) of
{ok, VsnString} ->
{ok, list_to_binary(VsnString)};
undefined ->
{error, failed_to_load_sophia}
end;
Err = {error, _} ->
Err
end;
{_App, _Des, VsnString} ->
{ok, list_to_binary(VsnString)}
end.
-spec numeric_version() -> {ok, [non_neg_integer()]} | {error, term()}.
numeric_version() ->
case version() of
{ok, Bin} ->
[NoSuf | _] = binary:split(Bin, <<"-">>),
Numbers = binary:split(NoSuf, <<".">>, [global]),
{ok, [binary_to_integer(Num) || Num <- Numbers]};
{error, _} = Err ->
Err
end.
-spec file(string()) -> {ok, map()} | {error, [so_errors:error()]}.
file(Filename) ->
file(Filename, []).
-spec file(string(), options()) -> {ok, map()} | {error, [so_errors:error()]}.
file(File, Options0) ->
Options = add_include_path(File, Options0),
case read_contract(File) of
{ok, Bin} ->
SrcDir = so_utils:canonical_dir(filename:dirname(File)),
from_string(Bin, [{src_file, File}, {src_dir, SrcDir} | Options]);
{error, Error} ->
Msg = lists:flatten([File,": ",file:format_error(Error)]),
{error, [so_errors:new(file_error, Msg)]}
end.
add_include_path(File, Options) ->
case lists:keymember(include, 1, Options) of
true -> Options;
false ->
Dir = filename:dirname(File),
{ok, Cwd} = file:get_cwd(),
[{include, {file_system, [Cwd, so_utils:canonical_dir(Dir)]}} | Options]
end.
-spec from_string(binary() | string(), options()) -> {ok, map()} | {error, [so_errors:error()]}.
from_string(ContractBin, Options) when is_binary(ContractBin) ->
from_string(binary_to_list(ContractBin), Options);
from_string(ContractString, Options) ->
try
from_string1(ContractString, Options)
catch
throw:{error, Errors} -> {error, Errors}
end.
from_string1(ContractString, Options) ->
#{ fcode := FCode
, fcode_env := FCodeEnv
, folded_typed_ast := FoldedTypedAst
, warnings := Warnings } = string_to_code(ContractString, Options),
#{ child_con_env := ChildContracts } = FCodeEnv,
SavedFreshNames = maps:get(saved_fresh_names, FCodeEnv, #{}),
FateCode = so_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
pp_assembler(FateCode, Options),
ByteCode = gmb_fate_code:serialize(FateCode, []),
{ok, Version} = version(),
Res = #{byte_code => ByteCode,
compiler_version => Version,
contract_source => ContractString,
type_info => [],
fate_code => FateCode,
abi_version => gmb_fate_abi:abi_version(),
payable => maps:get(payable, FCode),
warnings => Warnings
},
{ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}.
maybe_generate_aci(Result, FoldedTypedAst, Options) ->
case proplists:get_value(aci, Options) of
undefined ->
Result;
Type ->
{ok, Aci} = so_aci:from_typed_ast(Type, FoldedTypedAst),
maps:put(aci, Aci, Result)
end.
-spec string_to_code(string(), options()) -> map().
string_to_code(ContractString, Options) ->
Ast = parse(ContractString, Options),
pp_sophia_code(Ast, Options),
pp_ast(Ast, Options),
{TypeEnv, FoldedTypedAst, UnfoldedTypedAst, Warnings} = so_ast_infer_types:infer(Ast, [return_env | Options]),
pp_typed_ast(UnfoldedTypedAst, Options),
{Env, Fcode} = so_ast_to_fcode:ast_to_fcode(UnfoldedTypedAst, [{original_src, ContractString}|Options]),
#{ fcode => Fcode
, fcode_env => Env
, unfolded_typed_ast => UnfoldedTypedAst
, folded_typed_ast => FoldedTypedAst
, type_env => TypeEnv
, ast => Ast
, warnings => Warnings }.
-define(CALL_NAME, "__call").
%% Takes a string containing a contract with a declaration/prototype of a
%% function (foo, say) and adds function __call() = foo(args) calling this
%% function. Returns the name of the called functions, typereps and Erlang
%% terms for the arguments.
%% NOTE: Special treatment for "init" since it might be implicit and has
%% a special return type (typerep, T)
-spec check_call(string(), string(), [string()], options()) -> {ok, string(), [term()]}
| {error, [so_errors:error()]}.
check_call(Source, "init" = FunName, Args, Options) ->
case check_call1(Source, FunName, Args, Options) of
Err = {error, _} when Args == [] ->
%% Try with default init-function
case check_call1(insert_init_function(Source, Options), FunName, Args, Options) of
{error, _} -> Err; %% The first error is most likely better...
Res -> Res
end;
Res ->
Res
end;
check_call(Source, FunName, Args, Options) ->
check_call1(Source, FunName, Args, Options).
check_call1(ContractString0, FunName, Args, Options) ->
case add_extra_call(ContractString0, {call, FunName, Args}, Options) of
{ok, CallName, Code} ->
{def, _, _, FcodeArgs} = get_call_body(CallName, Code),
{ok, FunName, [ so_fcode_to_fate:term_to_fate(A) || A <- FcodeArgs ]};
Err = {error, _} ->
Err
end.
add_extra_call(Contract0, Call, Options) ->
try
%% First check the contract without the __call function
#{fcode := OrgFcode
, fcode_env := #{child_con_env := ChildContracts}
, ast := Ast} = string_to_code(Contract0, Options),
FateCode = so_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
%% collect all hashes and compute the first name without hash collision to
SymbolHashes = maps:keys(gmb_fate_code:symbols(FateCode)),
CallName = first_none_match(?CALL_NAME, SymbolHashes,
lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)),
Contract = insert_call_function(Ast, Contract0, CallName, Call),
{ok, CallName, string_to_code(Contract, Options)}
catch
throw:{error, Errors} -> {error, Errors}
end.
get_call_body(CallName, #{fcode := Fcode}) ->
#{body := Body} = maps:get({entrypoint, list_to_binary(CallName)}, maps:get(functions, Fcode)),
Body.
encode_value(Contract0, Type, Value, Options) ->
case add_extra_call(Contract0, {value, Type, Value}, Options) of
{ok, CallName, Code} ->
Body = get_call_body(CallName, Code),
{ok, gmb_fate_encoding:serialize(so_fcode_to_fate:term_to_fate(Body))};
Err = {error, _} ->
Err
end.
decode_value(Contract0, Type, FateValue, Options) ->
case add_extra_call(Contract0, {type, Type}, Options) of
{ok, CallName, Code} ->
#{ folded_typed_ast := TypedAst
, type_env := TypeEnv} = Code,
{ok, _, Type0} = get_decode_type(CallName, TypedAst),
Type1 = so_ast_infer_types:unfold_types_in_type(TypeEnv, Type0,
[ unfold_record_types
, unfold_variant_types
, not_unfold_system_alias_types ]),
fate_data_to_sophia_value(Type0, Type1, FateValue);
Err = {error, _} ->
Err
end.
first_none_match(_CallName, _Hashes, []) ->
error(unable_to_find_unique_call_name);
first_none_match(CallName, Hashes, [Char|Chars]) ->
case not lists:member(gmb_fate_code:symbol_identifier(list_to_binary(CallName)), Hashes) of
true ->
CallName;
false ->
first_none_match(?CALL_NAME++[Char], Hashes, Chars)
end.
%% Add the __call function to a contract.
-spec insert_call_function(so_syntax:ast(), string(), string(),
{call, string(), [string()]} | {value, string(), string()} | {type, string()}) -> string().
insert_call_function(Ast, Code, Call, {call, FunName, Args}) ->
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"stateful entrypoint ", Call, "() = ", FunName, "(", string:join(Args, ","), ")\n"
]);
insert_call_function(Ast, Code, Call, {value, Type, Value}) ->
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"entrypoint ", Call, "() : ", Type, " = ", Value, "\n"
]);
insert_call_function(Ast, Code, Call, {type, Type}) ->
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"entrypoint ", Call, "(val : ", Type, ") : ", Type, " = val\n"
]).
-spec insert_init_function(string(), options()) -> string().
insert_init_function(Code, Options) ->
Ast = parse(Code, Options),
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "), "entrypoint init() = ()\n"
]).
last_contract_indent(Decls) ->
case lists:last(Decls) of
{_, _, _, _, [Decl | _]} -> so_syntax:get_ann(col, Decl, 1) - 1;
_ -> 0
end.
-spec to_sophia_value(string(), string(), ok | error | revert, binary()) ->
{ok, so_syntax:expr()} | {error, [so_errors:error()]}.
to_sophia_value(ContractString, Fun, ResType, Data) ->
to_sophia_value(ContractString, Fun, ResType, Data, []).
-spec to_sophia_value(string(), string(), ok | error | revert, binary(), options()) ->
{ok, so_syntax:expr()} | {error, [so_errors:error()]}.
to_sophia_value(_, _, error, Err, _Options) ->
{ok, {app, [], {id, [], "error"}, [{string, [], Err}]}};
to_sophia_value(_, _, revert, Data, _Options) ->
try so_vm_decode:from_fate({id, [], "string"}, gmb_fate_encoding:deserialize(Data)) of
Err ->
{ok, {app, [], {id, [], "abort"}, [Err]}}
catch _:_ ->
Msg = "Could not deserialize the revert message",
{error, [so_errors:new(data_error, Msg)]}
end;
to_sophia_value(ContractString, FunName, ok, Data, Options0) ->
Options = [no_code | Options0],
try
Code = string_to_code(ContractString, Options),
#{ folded_typed_ast := TypedAst, type_env := TypeEnv} = Code,
{ok, _, Type0} = get_decode_type(FunName, TypedAst),
Type = so_ast_infer_types:unfold_types_in_type(TypeEnv, Type0,
[ unfold_record_types
, unfold_variant_types
, not_unfold_system_alias_types]),
fate_data_to_sophia_value(Type0, Type, Data)
catch
throw:{error, Errors} -> {error, Errors}
end.
fate_data_to_sophia_value(Type, UnfoldedType, FateData) ->
try
{ok, so_vm_decode:from_fate(UnfoldedType, gmb_fate_encoding:deserialize(FateData))}
catch throw:cannot_translate_to_sophia ->
Type1 = prettypr:format(so_pretty:type(Type)),
Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s",
[gmb_fate_encoding:deserialize(FateData), Type1]),
{error, [so_errors:new(data_error, Msg)]};
_:_ ->
Type1 = prettypr:format(so_pretty:type(Type)),
Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]),
{error, [so_errors:new(data_error, Msg)]}
end.
-spec create_calldata(string(), string(), [string()]) ->
{ok, binary()} | {error, [so_errors:error()]}.
create_calldata(Code, Fun, Args) ->
create_calldata(Code, Fun, Args, []).
-spec create_calldata(string(), string(), [string()], [{atom(), any()}]) ->
{ok, binary()} | {error, [so_errors:error()]}.
create_calldata(Code, Fun, Args, Options0) ->
Options = [no_code | Options0],
case check_call(Code, Fun, Args, Options) of
{ok, FunName, FateArgs} ->
gmb_fate_abi:create_calldata(FunName, FateArgs);
{error, _} = Err -> Err
end.
-spec decode_calldata(string(), string(), binary()) ->
{ok, [so_syntax:type()], [so_syntax:expr()]}
| {error, [so_errors:error()]}.
decode_calldata(ContractString, FunName, Calldata) ->
decode_calldata(ContractString, FunName, Calldata, []).
-spec decode_calldata(string(), string(), binary(), options()) ->
{ok, [so_syntax:type()], [so_syntax:expr()]}
| {error, [so_errors:error()]}.
decode_calldata(ContractString, FunName, Calldata, Options0) ->
Options = [no_code | Options0],
try
Code = string_to_code(ContractString, Options),
#{ folded_typed_ast := TypedAst, type_env := TypeEnv} = Code,
{ok, Args, _} = get_decode_type(FunName, TypedAst),
GetType = fun({typed, _, _, T}) -> T; (T) -> T end,
ArgTypes = lists:map(GetType, Args),
Type0 = {tuple_t, [], ArgTypes},
%% user defined data types such as variants needed to match against
Type = so_ast_infer_types:unfold_types_in_type(TypeEnv, Type0,
[ unfold_record_types
, unfold_variant_types
, not_unfold_system_alias_types]),
case gmb_fate_abi:decode_calldata(FunName, Calldata) of
{ok, FateArgs} ->
try
{tuple_t, [], ArgTypes1} = Type,
AstArgs = [ so_vm_decode:from_fate(ArgType, FateArg)
|| {ArgType, FateArg} <- lists:zip(ArgTypes1, FateArgs)],
{ok, ArgTypes, AstArgs}
catch throw:cannot_translate_to_sophia ->
Type0Str = prettypr:format(so_pretty:type(Type0)),
Msg = io_lib:format("Cannot translate FATE value ~p\n to Sophia type ~s",
[FateArgs, Type0Str]),
{error, [so_errors:new(data_error, Msg)]}
end;
{error, _} ->
Msg = io_lib:format("Failed to decode calldata binary", []),
{error, [so_errors:new(data_error, Msg)]}
end
catch
throw:{error, Errors} -> {error, Errors}
end.
-dialyzer({nowarn_function, get_decode_type/2}).
get_decode_type(FunName, [{Contract, Ann, _, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) ->
GetType = fun({letfun, _, {id, _, Name}, Args, Ret, _}) when Name == FunName -> [{Args, Ret}];
({fun_decl, _, {id, _, Name}, {fun_t, _, _, Args, Ret}}) when Name == FunName -> [{Args, Ret}];
(_) -> [] end,
case lists:flatmap(GetType, Defs) of
[{Args, Ret}] -> {ok, Args, Ret};
[] ->
case FunName of
"init" -> {ok, [], {tuple_t, [], []}};
_ ->
Msg = io_lib:format("Function '~s' is missing in contract", [FunName]),
Pos = so_errors:pos(Ann),
so_errors:throw(so_errors:new(data_error, Pos, Msg))
end
end;
get_decode_type(FunName, [_ | Contracts]) ->
%% The __decode should be in the final contract
get_decode_type(FunName, Contracts).
pp_sophia_code(C, Opts)-> pp(C, Opts, pp_sophia_code, fun(Code) ->
io:format("~s\n", [prettypr:format(so_pretty:decls(Code))])
end).
pp_ast(C, Opts) -> pp(C, Opts, pp_ast, fun so_ast:pp/1).
pp_typed_ast(C, Opts)-> pp(C, Opts, pp_typed_ast, fun so_ast:pp_typed/1).
pp_assembler(C, Opts) -> pp(C, Opts, pp_assembler, fun(Asm) -> io:format("~s", [gmb_fate_asm:pp(Asm)]) end).
pp(Code, Options, Option, PPFun) ->
case proplists:lookup(Option, Options) of
{Option1, true} when Option1 =:= Option ->
PPFun(Code);
none ->
ok
end.
%% -- Byte code validation ---------------------------------------------------
-define(protect(Tag, Code), fun() -> try Code catch _:Err1 -> throw({Tag, Err1}) end end()).
-spec validate_byte_code(map(), string(), options()) -> ok | {error, [so_errors:error()]}.
validate_byte_code(#{ byte_code := ByteCode, payable := Payable }, Source, Options) ->
Fail = fun(Err) -> {error, [so_errors:new(data_error, Err)]} end,
try
FCode1 = ?protect(deserialize, gmb_fate_code:strip_init_function(gmb_fate_code:deserialize(ByteCode))),
{FCode2, SrcPayable} =
?protect(compile,
begin
{ok, #{ byte_code := SrcByteCode, payable := SrcPayable }} =
from_string1(Source, Options),
FCode = gmb_fate_code:deserialize(SrcByteCode),
{gmb_fate_code:strip_init_function(FCode), SrcPayable}
end),
case compare_fate_code(FCode1, FCode2) of
ok when SrcPayable /= Payable ->
Not = fun(true) -> ""; (false) -> " not" end,
Fail(io_lib:format("Byte code contract is~s payable, but source code contract is~s.\n",
[Not(Payable), Not(SrcPayable)]));
ok -> ok;
{error, Why} -> Fail(io_lib:format("Byte code does not match source code.\n~s", [Why]))
end
catch
throw:{deserialize, _} -> Fail("Invalid byte code");
throw:{compile, {error, Errs}} -> {error, Errs}
end.
compare_fate_code(FCode1, FCode2) ->
Funs1 = gmb_fate_code:functions(FCode1),
Funs2 = gmb_fate_code:functions(FCode2),
Syms1 = gmb_fate_code:symbols(FCode1),
Syms2 = gmb_fate_code:symbols(FCode2),
FunHashes1 = maps:keys(Funs1),
FunHashes2 = maps:keys(Funs2),
case FunHashes1 == FunHashes2 of
false ->
InByteCode = [ binary_to_list(maps:get(H, Syms1)) || H <- FunHashes1 -- FunHashes2 ],
InSourceCode = [ binary_to_list(maps:get(H, Syms2)) || H <- FunHashes2 -- FunHashes1 ],
Msg = [ io_lib:format("- Functions in the byte code but not in the source code:\n"
" ~s\n", [string:join(InByteCode, ", ")]) || InByteCode /= [] ] ++
[ io_lib:format("- Functions in the source code but not in the byte code:\n"
" ~s\n", [string:join(InSourceCode, ", ")]) || InSourceCode /= [] ],
{error, Msg};
true ->
case lists:append([ compare_fate_fun(maps:get(H, Syms1), Fun1, Fun2)
|| {{H, Fun1}, {_, Fun2}} <- lists:zip(maps:to_list(Funs1),
maps:to_list(Funs2)) ]) of
[] -> ok;
Errs -> {error, Errs}
end
end.
compare_fate_fun(_Name, Fun, Fun) -> [];
compare_fate_fun(Name, {Attr, Type, _}, {Attr, Type, _}) ->
[io_lib:format("- The implementation of the function ~s is different.\n", [Name])];
compare_fate_fun(Name, {Attr1, Type, _}, {Attr2, Type, _}) ->
[io_lib:format("- The attributes of the function ~s differ:\n"
" Byte code: ~s\n"
" Source code: ~s\n",
[Name, string:join([ atom_to_list(A) || A <- Attr1 ], ", "),
string:join([ atom_to_list(A) || A <- Attr2 ], ", ")])];
compare_fate_fun(Name, {_, Type1, _}, {_, Type2, _}) ->
[io_lib:format("- The type of the function ~s differs:\n"
" Byte code: ~s\n"
" Source code: ~s\n",
[Name, pp_fate_sig(Type1), pp_fate_sig(Type2)])].
pp_fate_sig({[Arg], Res}) ->
io_lib:format("~s => ~s", [pp_fate_type(Arg), pp_fate_type(Res)]);
pp_fate_sig({Args, Res}) ->
io_lib:format("(~s) => ~s", [string:join([pp_fate_type(Arg) || Arg <- Args], ", "), pp_fate_type(Res)]).
pp_fate_type(T) -> io_lib:format("~w", [T]).
%% -------------------------------------------------------------------
-spec parse(string(), so_compiler:options()) -> none() | so_syntax:ast().
parse(Text, Options) ->
parse(Text, sets:new(), Options).
-spec parse(string(), sets:set(), so_compiler:options()) -> none() | so_syntax:ast().
parse(Text, Included, Options) ->
so_parser:string(Text, Included, Options).
read_contract(Name) ->
file:read_file(Name).

View File

@ -1,132 +0,0 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2019, Aeternity Anstalt
%%% @doc ADT for structured error messages + formatting.
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(so_errors).
-vsn("9.0.0").
-type src_file() :: no_file | iolist().
-record(pos, { file = no_file :: src_file()
, line = 0 :: non_neg_integer()
, col = 0 :: non_neg_integer()
}).
-type pos() :: #pos{}.
-type error_type() :: type_error | parse_error | code_error
| file_error | data_error | internal_error.
-record(err, { pos = #pos{} :: pos()
, type :: error_type()
, message :: iolist()
, context = none :: none | iolist()
}).
-opaque error() :: #err{}.
-export_type([error/0, pos/0]).
-export([ err_msg/1
, msg/1
, msg_oneline/1
, new/2
, new/3
, new/4
, pos/1
, pos/2
, pos/3
, pp/1
, pp_oneline/1
, pp_pos/1
, to_json/1
, throw/1
, type/1
]).
new(Type, Msg) ->
new(Type, pos(0, 0), Msg).
new(Type, Pos, Msg) ->
#err{ type = Type, pos = Pos, message = Msg }.
new(Type, Pos, Msg, Ctxt) ->
#err{ type = Type, pos = Pos, message = Msg, context = Ctxt }.
pos(Ann) ->
File = so_syntax:get_ann(file, Ann, no_file),
Line = so_syntax:get_ann(line, Ann, 0),
Col = so_syntax:get_ann(col, Ann, 0),
pos(File, Line, Col).
pos(Line, Col) ->
#pos{ line = Line, col = Col }.
pos(File, Line, Col) ->
#pos{ file = File, line = Line, col = Col }.
-spec throw(_) -> ok | no_return().
throw([]) -> ok;
throw(Errs) when is_list(Errs) ->
SortedErrs = lists:sort(fun(E1, E2) -> E1#err.pos =< E2#err.pos end, Errs),
erlang:throw({error, SortedErrs});
throw(#err{} = Err) ->
erlang:throw({error, [Err]}).
msg(#err{ message = Msg, context = none }) -> Msg;
msg(#err{ message = Msg, context = Ctxt }) -> Msg ++ "\n" ++ Ctxt.
msg_oneline(#err{ message = Msg, context = none }) -> Msg;
msg_oneline(#err{ message = Msg, context = Ctxt }) -> Msg ++ " - " ++ Ctxt.
err_msg(#err{ pos = Pos } = Err) ->
lists:flatten(io_lib:format("~s~s\n", [str_pos(Pos), msg(Err)])).
str_pos(#pos{file = no_file, line = L, col = C}) ->
io_lib:format("~p:~p:", [L, C]);
str_pos(#pos{file = F, line = L, col = C}) ->
io_lib:format("~s:~p:~p:", [F, L, C]).
type(#err{ type = Type }) -> Type.
pp(#err{ type = Kind, pos = Pos } = Err) ->
lists:flatten(io_lib:format("~s~s:\n~s\n", [pp_kind(Kind), pp_pos(Pos), msg(Err)])).
pp_oneline(#err{ type = Kind, pos = Pos } = Err) ->
Msg = msg_oneline(Err),
OneLineMsg = re:replace(Msg, "[\s\\n]+", " ", [global]),
lists:flatten(io_lib:format("~s~s: ~s", [pp_kind(Kind), pp_pos(Pos), OneLineMsg])).
pp_kind(type_error) -> "Type error";
pp_kind(parse_error) -> "Parse error";
pp_kind(code_error) -> "Code generation error";
pp_kind(file_error) -> "File error";
pp_kind(data_error) -> "Data error";
pp_kind(internal_error) -> "Internal error".
pp_pos(#pos{file = no_file, line = 0, col = 0}) ->
"";
pp_pos(#pos{file = no_file, line = L, col = C}) ->
io_lib:format(" at line ~p, col ~p", [L, C]);
pp_pos(#pos{file = F, line = L, col = C}) ->
io_lib:format(" in '~s' at line ~p, col ~p", [F, L, C]).
to_json(#err{pos = Pos, type = Type, message = Msg, context = Cxt}) ->
Json = #{ pos => pos_to_json(Pos),
type => atom_to_binary(Type, utf8),
message => iolist_to_binary(Msg) },
case Cxt of
none -> Json;
_ -> Json#{ context => iolist_to_binary(Cxt) }
end.
pos_to_json(#pos{ file = File, line = Line, col = Col }) ->
Json = #{ line => Line, col => Col },
case File of
no_file -> Json;
_ -> Json#{ file => iolist_to_binary(File) }
end.

File diff suppressed because it is too large Load Diff

View File

@ -1,194 +0,0 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2025, QPQ AG
%%% @copyright (C) 2017, Aeternity Anstalt
%%% @doc Decoding fate data to AST
%%% @end
%%%-------------------------------------------------------------------
-module(so_vm_decode).
-vsn("9.0.0").
-export([ from_fate/2 ]).
-include_lib("gmbytecode/include/gmb_fate_data.hrl").
-spec from_fate(so_syntax:type(), gmb_fate_data:fate_type()) -> so_syntax:expr().
from_fate({id, _, "address"}, ?FATE_ADDRESS(Bin)) -> {account_pubkey, [], Bin};
from_fate({id, _, "signature"}, ?FATE_BYTES(Bin)) -> {signature, [], Bin};
from_fate({id, _, "hash"}, ?FATE_BYTES(Bin)) -> {bytes, [], Bin};
from_fate({id, _, "unit"}, ?FATE_UNIT) -> {tuple, [], []};
from_fate({con, _, _Name}, ?FATE_CONTRACT(Bin)) -> {contract_pubkey, [], Bin};
from_fate({bytes_t, _, any}, ?FATE_BYTES(Bin)) -> make_any_bytes(Bin);
from_fate({bytes_t, _, N}, ?FATE_BYTES(Bin)) when byte_size(Bin) == N -> {bytes, [], Bin};
from_fate({id, _, "bits"}, ?FATE_BITS(N)) -> make_bits(N);
from_fate({id, _, "int"}, N) when is_integer(N) ->
if N < 0 -> {app, [{format, prefix}], {'-', []}, [{int, [], -N}]};
true -> {int, [], N} end;
from_fate({id, _, "bool"}, B) when is_boolean(B) -> {bool, [], B};
from_fate({id, _, "string"}, S) when is_binary(S) -> {string, [], S};
from_fate({app_t, _, {id, _, "list"}, [Type]}, List) when is_list(List) ->
{list, [], [from_fate(Type, X) || X <- List]};
from_fate({app_t, _, {id, _, "option"}, [Type]}, Val) ->
case Val of
{variant, [0, 1], 0, {}} -> {con, [], "None"};
{variant, [0, 1], 1, {X}} -> {app, [], {con, [], "Some"}, [from_fate(Type, X)]}
end;
from_fate({tuple_t, _, []}, ?FATE_UNIT) ->
{tuple, [], []};
from_fate({tuple_t, _, Types}, ?FATE_TUPLE(Val))
when length(Types) == tuple_size(Val) ->
{tuple, [], [from_fate(Type, X)
|| {Type, X} <- lists:zip(Types, tuple_to_list(Val))]};
from_fate({record_t, [{field_t, _, FName, FType}]}, Val) ->
{record, [], [{field, [], [{proj, [], FName}], from_fate(FType, Val)}]};
from_fate({record_t, Fields}, ?FATE_TUPLE(Val))
when length(Fields) == tuple_size(Val) ->
{record, [], [ {field, [], [{proj, [], FName}], from_fate(FType, X)}
|| {{field_t, _, FName, FType}, X} <- lists:zip(Fields, tuple_to_list(Val)) ]};
from_fate({app_t, _, {id, _, "map"}, [KeyType, ValType]}, Map)
when is_map(Map) ->
{map, [], [ {from_fate(KeyType, Key),
from_fate(ValType, Val)}
|| {Key, Val} <- maps:to_list(Map) ]};
from_fate({variant_t, Cons}, {variant, Ar, Tag, Args})
when length(Cons) > Tag ->
ConType = lists:nth(Tag + 1, Cons),
Arity = lists:nth(Tag + 1, Ar),
case tuple_to_list(Args) of
ArgList when length(ArgList) == Arity ->
from_fate(ConType, ArgList);
_ -> throw(cannot_translate_to_sophia)
end;
from_fate({constr_t, _, Con, []}, []) -> Con;
from_fate({constr_t, _, Con, Types}, Args)
when length(Types) == length(Args) ->
{app, [], Con, [ from_fate(Type, Arg)
|| {Type, Arg} <- lists:zip(Types, Args) ]};
from_fate({qid, _, QType}, Val) ->
from_fate_builtin(QType, Val);
from_fate(_Type, _Data) ->
throw(cannot_translate_to_sophia).
from_fate_builtin(QType, Val) ->
Con = fun([Name | _] = Names) when is_list(Name) -> {qcon, [], Names};
(Name) -> {con, [], Name} end,
App = fun(Name, []) -> Con(Name);
(Name, Value) -> {app, [], Con(Name), Value} end,
Chk = fun(Type, Value) -> from_fate(Type, Value) end,
Int = {id, [], "int"},
Str = {id, [], "string"},
Adr = {id, [], "address"},
Hsh = {bytes_t, [], 32},
I32 = {bytes_t, [], 32},
I48 = {bytes_t, [], 48},
Bts = {bytes_t, [], any},
Qid = fun(Name) -> {qid, [], Name} end,
Map = fun(KT, VT) -> {app_t, [], {id, [], "map"}, [KT, VT]} end,
ChainTxArities = [3, 0, 0, 0, 0, 0, 1, 1, 1, 2, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 2, 0],
case {QType, Val} of
{["Chain", "ttl"], {variant, [1, 1], 0, {X}}} -> App("RelativeTTL", [Chk(Int, X)]);
{["Chain", "ttl"], {variant, [1, 1], 1, {X}}} -> App("FixedTTL", [Chk(Int, X)]);
{["AENS", "name"], {variant, [3], 0, {Addr, TTL, Ptrs}}} ->
App(["AENS","Name"], [Chk(Adr, Addr), Chk(Qid(["Chain", "ttl"]), TTL),
Chk(Map(Str, Qid(["AENS", "pointee"])), Ptrs)]);
{["AENS", "pointee"], {variant, [1, 1, 1, 1], 0, {Addr}}} ->
App(["AENS","AccountPt"], [Chk(Adr, Addr)]);
{["AENS", "pointee"], {variant, [1, 1, 1, 1], 1, {Addr}}} ->
App(["AENS","OraclePt"], [Chk(Adr, Addr)]);
{["AENS", "pointee"], {variant, [1, 1, 1, 1], 2, {Addr}}} ->
App(["AENS","ContractPt"], [Chk(Adr, Addr)]);
{["AENS", "pointee"], {variant, [1, 1, 1, 1], 3, {Addr}}} ->
App(["AENS","ChannelPt"], [Chk(Adr, Addr)]);
{["AENSv2", "name"], {variant, [3], 0, {Addr, TTL, Ptrs}}} ->
App(["AENSv2","Name"], [Chk(Adr, Addr), Chk(Qid(["Chain", "ttl"]), TTL),
Chk(Map(Str, Qid(["AENSv2", "pointee"])), Ptrs)]);
{["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 0, {Value}}} ->
App(["AENSv2","AccountPt"], [Chk(Adr, Value)]);
{["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 1, {Value}}} ->
App(["AENSv2","OraclePt"], [Chk(Adr, Value)]);
{["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 2, {Value}}} ->
App(["AENSv2","ContractPt"], [Chk(Adr, Value)]);
{["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 3, {Value}}} ->
App(["AENSv2","ChannelPt"], [Chk(Adr, Value)]);
{["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 4, {Value}}} ->
App(["AENSv2","DataPt"], [Chk(Bts, Value)]);
{["Chain", "ga_meta_tx"], {variant, [2], 0, {Addr, X}}} ->
App(["Chain","GAMetaTx"], [Chk(Adr, Addr), Chk(Int, X)]);
{["Chain", "paying_for_tx"], {variant, [2], 0, {Addr, X}}} ->
App(["Chain","PayingForTx"], [Chk(Adr, Addr), Chk(Int, X)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 0, {Addr, Fee, Payload}}} ->
App(["Chain","SpendTx"], [Chk(Adr, Addr), Chk(Int, Fee), Chk(Str, Payload)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 1, {}}} ->
App(["Chain","OracleRegisterTx"], []);
{["Chain", "base_tx"], {variant, ChainTxArities, 2, {}}} ->
App(["Chain","OracleQueryTx"], []);
{["Chain", "base_tx"], {variant, ChainTxArities, 3, {}}} ->
App(["Chain","OracleResponseTx"], []);
{["Chain", "base_tx"], {variant, ChainTxArities, 4, {}}} ->
App(["Chain","OracleExtendTx"], []);
{["Chain", "base_tx"], {variant, ChainTxArities, 5, {}}} ->
App(["Chain","NamePreclaimTx"], []);
{["Chain", "base_tx"], {variant, ChainTxArities, 6, {Name}}} ->
App(["Chain","NameClaimTx"], [Chk(Str, Name)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 7, {NameHash}}} ->
App(["Chain","NameUpdateTx"], [Chk(Hsh, NameHash)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 8, {NameHash}}} ->
App(["Chain","NameRevokeTx"], [Chk(Hsh, NameHash)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 9, {NewOwner, NameHash}}} ->
App(["Chain","NameTransferTx"], [Chk(Adr, NewOwner), Chk(Hsh, NameHash)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 10, {Addr}}} ->
App(["Chain","ChannelCreateTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 11, {Addr, Amount}}} ->
App(["Chain","ChannelDepositTx"], [Chk(Adr, Addr), Chk(Int, Amount)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 12, {Addr, Amount}}} ->
App(["Chain","ChannelWithdrawTx"], [Chk(Adr, Addr), Chk(Int, Amount)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 13, {Addr}}} ->
App(["Chain","ChannelForceProgressTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 14, {Addr}}} ->
App(["Chain","ChannelCloseMutualTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 15, {Addr}}} ->
App(["Chain","ChannelCloseSoloTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 16, {Addr}}} ->
App(["Chain","ChannelSlashTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 17, {Addr}}} ->
App(["Chain","ChannelSettleTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 18, {Addr}}} ->
App(["Chain","ChannelSnapshotSoloTx"], [Chk(Adr, Addr)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 19, {Amount}}} ->
App(["Chain","ContractCreateTx"], [Chk(Int, Amount)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 20, {Addr, Amount}}} ->
App(["Chain","ContractCallTx"], [Chk(Adr, Addr), Chk(Int, Amount)]);
{["Chain", "base_tx"], {variant, ChainTxArities, 21, {}}} ->
App(["Chain","GAAttachTx"], []);
{["MCL_BLS12_381", "fp"], X} ->
App(["MCL_BLS12_381", "fp"], [Chk(I32, X)]);
{["MCL_BLS12_381", "fr"], X} ->
App(["MCL_BLS12_381", "fr"], [Chk(I48, X)]);
_ ->
throw(cannot_translate_to_sophia)
end.
make_bits(N) ->
Id = fun(F) -> {qid, [], ["Bits", F]} end,
if N < 0 -> make_bits(Id("clear"), Id("all"), 0, bnot N);
true -> make_bits(Id("set"), Id("none"), 0, N) end.
make_bits(_Set, Zero, _I, 0) -> Zero;
make_bits(Set, Zero, I, N) when 0 == N rem 2 ->
make_bits(Set, Zero, I + 1, N div 2);
make_bits(Set, Zero, I, N) ->
{app, [], Set, [make_bits(Set, Zero, I + 1, N div 2), {int, [], I}]}.
make_any_bytes(Bin) ->
{app, [], {qid, [], ["Bytes", "to_any_size"]}, [{bytes, [], Bin}]}.

View File

@ -1,32 +0,0 @@
-module(so_warnings).
-vsn("9.0.0").
-record(warn, { pos :: so_errors:pos()
, message :: iolist()
}).
-opaque warning() :: #warn{}.
-export_type([warning/0]).
-export([ new/1
, new/2
, warn_to_err/2
, sort_warnings/1
, pp/1
]).
new(Msg) ->
new(so_errors:pos(0, 0), Msg).
new(Pos, Msg) ->
#warn{ pos = Pos, message = Msg }.
warn_to_err(Kind, #warn{ pos = Pos, message = Msg }) ->
so_errors:new(Kind, Pos, lists:flatten(Msg)).
sort_warnings(Warnings) ->
lists:sort(fun(W1, W2) -> W1#warn.pos =< W2#warn.pos end, Warnings).
pp(#warn{ pos = Pos, message = Msg }) ->
lists:flatten(io_lib:format("Warning~s:\n~s", [so_errors:pp_pos(Pos), Msg])).

200
test/aeso_abi_tests.erl Normal file
View File

@ -0,0 +1,200 @@
-module(aeso_abi_tests).
-include_lib("eunit/include/eunit.hrl").
-compile([export_all, nowarn_export_all]).
-define(SANDBOX(Code), sandbox(fun() -> Code end)).
-define(DUMMY_HASH_WORD, 16#123).
-define(DUMMY_HASH, <<0:30/unit:8, 127, 119>>). %% 16#123
-define(DUMMY_HASH_LIT, "#0000000000000000000000000000000000000000000000000000000000000123").
sandbox(Code) ->
Parent = self(),
Tag = make_ref(),
{Pid, Ref} = spawn_monitor(fun() -> Parent ! {Tag, Code()} end),
receive
{Tag, Res} -> erlang:demonitor(Ref, [flush]), {ok, Res};
{'DOWN', Ref, process, Pid, Reason} -> {error, Reason}
after 100 ->
exit(Pid, kill),
{error, loop}
end.
malicious_from_binary_test() ->
CircularList = from_words([32, 1, 32]), %% Xs = 1 :: Xs
{ok, {error, circular_references}} = ?SANDBOX(aeb_heap:from_binary({list, word}, CircularList)),
{ok, {error, {binary_too_short, _}}} = ?SANDBOX(aeb_heap:from_binary(word, <<1, 2, 3, 4>>)),
ok.
from_words(Ws) ->
<< <<(from_word(W))/binary>> || W <- Ws >>.
from_word(W) when is_integer(W) ->
<<W:256>>;
from_word(S) when is_list(S) ->
Len = length(S),
Bin = <<(list_to_binary(S))/binary, 0:(32 - Len)/unit:8>>,
<<Len:256, Bin/binary>>.
encode_decode_test() ->
encode_decode(word, 42),
42 = encode_decode(word, 42),
-1 = encode_decode(signed_word, -1),
<<"Hello world">> = encode_decode(string, <<"Hello world">>),
{} = encode_decode({tuple, []}, {}),
{42} = encode_decode({tuple, [word]}, {42}),
{42, 0} = encode_decode({tuple, [word, word]}, {42, 0}),
[] = encode_decode({list, word}, []),
[32] = encode_decode({list, word}, [32]),
none = encode_decode({option, word}, none),
{some, 1} = encode_decode({option, word}, {some, 1}),
string = encode_decode(typerep, string),
word = encode_decode(typerep, word),
{list, word} = encode_decode(typerep, {list, word}),
{tuple, [word]} = encode_decode(typerep, {tuple, [word]}),
1 = encode_decode(word, 1),
0 = encode_decode(word, 0),
ok.
encode_decode_sophia_test() ->
Check = fun(Type, Str) -> case {encode_decode_sophia_string(Type, Str), Str} of
{X, X} -> ok;
Other -> Other
end end,
ok = Check("int", "42"),
ok = Check("int", "-42"),
ok = Check("bool", "true"),
ok = Check("bool", "false"),
ok = Check("string", "\"Hello\""),
ok = Check("string * list(int) * option(bool)",
"(\"Hello\", [1, 2, 3], Some(true))"),
ok = Check("variant", "Blue({[\"x\"] = 1})"),
ok = Check("r", "{x = (\"foo\", 0), y = Red}"),
ok.
encode_decode_sophia_string(SophiaType, String) ->
io:format("String ~p~n", [String]),
Code = [ "contract MakeCall =\n"
, " type arg_type = ", SophiaType, "\n"
, " type an_alias('a) = string * 'a\n"
, " record r = {x : an_alias(int), y : variant}\n"
, " datatype variant = Red | Blue(map(string, int))\n"
, " entrypoint foo : arg_type => arg_type\n" ],
case aeso_compiler:check_call(lists:flatten(Code), "foo", [String], []) of
{ok, _, {[Type], _}, [Arg]} ->
io:format("Type ~p~n", [Type]),
Data = encode(Arg),
case aeso_compiler:to_sophia_value(Code, "foo", ok, Data, []) of
{ok, Sophia} ->
lists:flatten(io_lib:format("~s", [prettypr:format(aeso_pretty:expr(Sophia))]));
{error, Err} ->
io:format("~s\n", [Err]),
{error, Err}
end;
{error, Err} ->
io:format("~s\n", [Err]),
{error, Err}
end.
calldata_test() ->
[42, <<"foobar">>] = encode_decode_calldata("foo", ["int", "string"], ["42", "\"foobar\""]),
Map = #{ <<"a">> => 4 },
[{variant, 1, [Map]}, {{<<"b">>, 5}, {variant, 0, []}}] =
encode_decode_calldata("foo", ["variant", "r"], ["Blue({[\"a\"] = 4})", "{x = (\"b\", 5), y = Red}"]),
[?DUMMY_HASH_WORD, 16#456] = encode_decode_calldata("foo", ["bytes(32)", "address"],
[?DUMMY_HASH_LIT, "ak_1111111111111111111111111111113AFEFpt5"]),
[?DUMMY_HASH_WORD, ?DUMMY_HASH_WORD] =
encode_decode_calldata("foo", ["bytes(32)", "hash"], [?DUMMY_HASH_LIT, ?DUMMY_HASH_LIT]),
[119, {0, 0}] = encode_decode_calldata("foo", ["int", "signature"], ["119", [$# | lists:duplicate(128, $0)]]),
[16#456] = encode_decode_calldata("foo", ["Remote"], ["ct_1111111111111111111111111111113AFEFpt5"]),
ok.
calldata_init_test() ->
encode_decode_calldata("init", ["int"], ["42"], {tuple, [typerep, word]}),
Code = parameterized_contract("foo", ["int"]),
encode_decode_calldata_(Code, "init", [], {tuple, [typerep, {tuple, []}]}).
calldata_indent_test() ->
Test = fun(Extra) ->
Code = parameterized_contract(Extra, "foo", ["int"]),
encode_decode_calldata_(Code, "foo", ["42"], word)
end,
Test(" stateful entrypoint bla() = ()"),
Test(" type x = int"),
Test(" stateful entrypoint bla(x : int) =\n"
" x + 1"),
Test(" stateful entrypoint bla(x : int) : int =\n"
" x + 1"),
ok.
parameterized_contract(FunName, Types) ->
parameterized_contract([], FunName, Types).
parameterized_contract(ExtraCode, FunName, Types) ->
lists:flatten(
["contract Remote =\n"
" entrypoint bla : () => unit\n\n"
"contract Dummy =\n",
ExtraCode, "\n",
" type an_alias('a) = string * 'a\n"
" record r = {x : an_alias(int), y : variant}\n"
" datatype variant = Red | Blue(map(string, int))\n"
" entrypoint ", FunName, " : (", string:join(Types, ", "), ") => int\n" ]).
oracle_test() ->
Contract =
"contract OracleTest =\n"
" entrypoint question(o, q : oracle_query(list(string), option(int))) =\n"
" Oracle.get_question(o, q)\n",
{ok, _, {[word, word], {list, string}}, [16#123, 16#456]} =
aeso_compiler:check_call(Contract, "question", ["ok_111111111111111111111111111111ZrdqRz9",
"oq_1111111111111111111111111111113AFEFpt5"], []),
ok.
permissive_literals_fail_test() ->
Contract =
"contract OracleTest =\n"
" stateful entrypoint haxx(o : oracle(list(string), option(int))) =\n"
" Chain.spend(o, 1000000)\n",
{error, <<"Type errors\nCannot unify", _/binary>>} =
aeso_compiler:check_call(Contract, "haxx", ["#123"], []),
ok.
encode_decode_calldata(FunName, Types, Args) ->
encode_decode_calldata(FunName, Types, Args, word).
encode_decode_calldata(FunName, Types, Args, RetType) ->
Code = parameterized_contract(FunName, Types),
encode_decode_calldata_(Code, FunName, Args, RetType).
encode_decode_calldata_(Code, FunName, Args, RetVMType) ->
{ok, Calldata} = aeso_compiler:create_calldata(Code, FunName, Args, []),
{ok, _, {ArgTypes, RetType}, _} = aeso_compiler:check_call(Code, FunName, Args, [{backend, aevm}]),
?assertEqual(RetType, RetVMType),
CalldataType = {tuple, [word, {tuple, ArgTypes}]},
{ok, {_Hash, ArgTuple}} = aeb_heap:from_binary(CalldataType, Calldata),
case FunName of
"init" ->
ok;
_ ->
{ok, _ArgTypes, ValueASTs} = aeso_compiler:decode_calldata(Code, FunName, Calldata, []),
Values = [ prettypr:format(aeso_pretty:expr(V)) || V <- ValueASTs ],
?assertMatch({X, X}, {Args, Values})
end,
tuple_to_list(ArgTuple).
encode_decode(T, D) ->
?assertEqual(D, decode(T, encode(D))),
D.
encode(D) ->
aeb_heap:to_binary(D).
decode(T,B) ->
{ok, D} = aeb_heap:from_binary(T, B),
D.

125
test/aeso_aci_tests.erl Normal file
View File

@ -0,0 +1,125 @@
-module(aeso_aci_tests).
-include_lib("eunit/include/eunit.hrl").
simple_aci_test_() ->
[{"Test contract " ++ integer_to_list(N),
fun() -> test_contract(N) end}
|| N <- [1, 2, 3]].
test_contract(N) ->
{Contract,MapACI,DecACI} = test_cases(N),
{ok,JSON} = aeso_aci:contract_interface(json, Contract),
?assertEqual([MapACI], JSON),
?assertEqual({ok, DecACI}, aeso_aci:render_aci_json(JSON)).
test_cases(1) ->
Contract = <<"payable contract C =\n"
" payable stateful entrypoint a(i : int) = i+1\n">>,
MapACI = #{contract =>
#{name => <<"C">>,
type_defs => [],
payable => true,
functions =>
[#{name => <<"a">>,
arguments =>
[#{name => <<"i">>,
type => <<"int">>}],
returns => <<"int">>,
stateful => true,
payable => true}]}},
DecACI = <<"payable contract C =\n"
" payable entrypoint a : (int) => int\n">>,
{Contract,MapACI,DecACI};
test_cases(2) ->
Contract = <<"contract C =\n"
" type allan = int\n"
" entrypoint a(i : allan) = i+1\n">>,
MapACI = #{contract =>
#{name => <<"C">>, payable => false,
type_defs =>
[#{name => <<"allan">>,
typedef => <<"int">>,
vars => []}],
functions =>
[#{arguments =>
[#{name => <<"i">>,
type => <<"C.allan">>}],
name => <<"a">>,
returns => <<"int">>,
stateful => false,
payable => false}]}},
DecACI = <<"contract C =\n"
" type allan = int\n"
" entrypoint a : (C.allan) => int\n">>,
{Contract,MapACI,DecACI};
test_cases(3) ->
Contract = <<"contract C =\n"
" type state = unit\n"
" datatype event = SingleEventDefined\n"
" datatype bert('a) = Bin('a)\n"
" entrypoint a(i : bert(string)) = 1\n">>,
MapACI = #{contract =>
#{functions =>
[#{arguments =>
[#{name => <<"i">>,
type =>
#{<<"C.bert">> => [<<"string">>]}}],
name => <<"a">>,returns => <<"int">>,
stateful => false, payable => false}],
name => <<"C">>, payable => false,
event => #{variant => [#{<<"SingleEventDefined">> => []}]},
state => <<"unit">>,
type_defs =>
[#{name => <<"bert">>,
typedef =>
#{variant =>
[#{<<"Bin">> => [<<"'a">>]}]},
vars => [#{name => <<"'a">>}]}]}},
DecACI = <<"contract C =\n"
" type state = unit\n"
" datatype event = SingleEventDefined\n"
" datatype bert('a) = Bin('a)\n"
" entrypoint a : (C.bert(string)) => int\n">>,
{Contract,MapACI,DecACI}.
%% Rounttrip
aci_test_() ->
[{"Testing ACI generation for " ++ ContractName,
fun() -> aci_test_contract(ContractName) end}
|| ContractName <- all_contracts()].
all_contracts() -> aeso_compiler_tests:compilable_contracts().
aci_test_contract(Name) ->
String = aeso_test_utils:read_contract(Name),
Opts = [{include, {file_system, [aeso_test_utils:contract_path()]}}],
{ok, JSON} = aeso_aci:contract_interface(json, String, Opts),
io:format("JSON:\n~p\n", [JSON]),
{ok, ContractStub} = aeso_aci:render_aci_json(JSON),
io:format("STUB:\n~s\n", [ContractStub]),
check_stub(ContractStub, [{src_file, Name}]),
ok.
check_stub(Stub, Options) ->
case aeso_parser:string(binary_to_list(Stub), Options) of
{ok, Ast} ->
try
%% io:format("AST: ~120p\n", [Ast]),
aeso_ast_infer_types:infer(Ast, [])
catch _:{type_errors, TE} ->
io:format("Type error:\n~s\n", [TE]),
error(TE);
_:R ->
io:format("Error: ~p\n", [R]),
error(R)
end;
{error, E} ->
io:format("Error: ~p\n", [E]),
error({parse_error, E})
end.

View File

@ -0,0 +1,129 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2019, Aeternity Anstalt
%%% @doc Test Sophia language compiler.
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(aeso_calldata_tests).
-compile([export_all, nowarn_export_all]).
-include_lib("eunit/include/eunit.hrl").
%% Very simply test compile the given contracts. Only basic checks
%% are made on the output, just that it is a binary which indicates
%% that the compilation worked.
calldata_test_() ->
[ {"Testing " ++ ContractName ++ " contract calling " ++ Fun,
fun() ->
ContractString = aeso_test_utils:read_contract(ContractName),
AevmExprs =
case not lists:member(ContractName, not_yet_compilable(aevm)) of
true -> ast_exprs(ContractString, Fun, Args, [{backend, aevm}]);
false -> undefined
end,
FateExprs =
case not lists:member(ContractName, not_yet_compilable(fate)) of
true -> ast_exprs(ContractString, Fun, Args, [{backend, fate}]);
false -> undefined
end,
case FateExprs == undefined orelse AevmExprs == undefined of
true -> ok;
false ->
?assertEqual(FateExprs, AevmExprs)
end
end} || {ContractName, Fun, Args} <- compilable_contracts()].
calldata_aci_test_() ->
[ {"Testing " ++ ContractName ++ " contract calling " ++ Fun,
fun() ->
ContractString = aeso_test_utils:read_contract(ContractName),
{ok, ContractACIBin} = aeso_aci:contract_interface(string, ContractString),
ContractACI = binary_to_list(ContractACIBin),
io:format("ACI:\n~s\n", [ContractACIBin]),
AevmExprs =
case not lists:member(ContractName, not_yet_compilable(aevm)) of
true -> ast_exprs(ContractACI, Fun, Args, [{backend, aevm}]);
false -> undefined
end,
FateExprs =
case not lists:member(ContractName, not_yet_compilable(fate)) of
true -> ast_exprs(ContractACI, Fun, Args, [{backend, fate}]);
false -> undefined
end,
case FateExprs == undefined orelse AevmExprs == undefined of
true -> ok;
false ->
?assertEqual(FateExprs, AevmExprs)
end
end} || {ContractName, Fun, Args} <- compilable_contracts()].
ast_exprs(ContractString, Fun, Args, Opts) ->
{ok, Data} = (catch aeso_compiler:create_calldata(ContractString, Fun, Args, Opts)),
{ok, _Types, Exprs} = (catch aeso_compiler:decode_calldata(ContractString, Fun, Data, Opts)),
?assert(is_list(Exprs)),
Exprs.
check_errors(Expect, ErrorString) ->
%% This removes the final single \n as well.
Actual = binary:split(<<ErrorString/binary,$\n>>, <<"\n\n">>, [global,trim]),
case {Expect -- Actual, Actual -- Expect} of
{[], Extra} -> ?assertMatch({unexpected, []}, {unexpected, Extra});
{Missing, []} -> ?assertMatch({missing, []}, {missing, Missing});
{Missing, Extra} -> ?assertEqual(Missing, Extra)
end.
%% compilable_contracts() -> [ContractName].
%% The currently compilable contracts.
compilable_contracts() ->
[
{"identity", "init", []},
{"maps", "init", []},
{"funargs", "menot", ["false"]},
{"funargs", "append", ["[\"false\", \" is\", \" not\", \" true\"]"]},
%% TODO {"funargs", "bitsum", ["Bits.all"]},
{"funargs", "read", ["{label = \"question 1\", result = 4}"]},
{"funargs", "sjutton", ["#0011012003100011012003100011012003"]},
{"funargs", "sextiosju", ["#01020304050607080910111213141516171819202122232425262728293031323334353637383940"
"414243444546474849505152535455565758596061626364656667"]},
{"funargs", "trettiotva", ["#0102030405060708091011121314151617181920212223242526272829303132"]},
{"funargs", "find_oracle", ["ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5"]},
{"funargs", "find_query", ["oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY"]},
{"funargs", "traffic_light", ["Green"]},
{"funargs", "traffic_light", ["Pantone(12)"]},
{"funargs", "tuples", ["()"]},
%% TODO {"funargs", "due", ["FixedTTL(1020)"]},
{"variant_types", "init", []},
{"basic_auth", "init", []},
{"address_literals", "init", []},
{"bytes_equality", "init", []},
{"address_chain", "init", []},
{"counter", "init",
["-3334353637383940202122232425262728293031323334353637"]},
{"dutch_auction", "init",
["ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt", "200000", "1000"]},
{"maps", "fromlist_i",
["[(1, {x = 1, y = 2}), (2, {x = 3, y = 4}), (3, {x = 4, y = 4})]"]},
{"maps", "get_i", ["1", "{}"]},
{"maps", "get_i", ["1", "{[1] = {x = 3, y = 4}}"]},
{"maps", "get_i", ["1", "{[1] = {x = 3, y = 4}, [2] = {x = 4, y = 5}}"]},
{"maps", "get_i", ["1", "{[1] = {x = 3, y = 4}, [2] = {x = 4, y = 5}, [3] = {x = 5, y = 6}}"]},
{"strings", "str_concat", ["\"test\"","\"me\""]},
{"complex_types", "filter_some", ["[Some(11), Some(12), None]"]},
{"complex_types", "init", ["ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ"]},
{"__call" "init", []},
{"bitcoin_auth", "authorize", ["1", "#0102030405060708090a0b0c0d0e0f101718192021222324252627282930313233343536373839401a1b1c1d1e1f20212223242526272829303132333435363738"]},
{"bitcoin_auth", "to_sign", ["#0102030405060708090a0b0c0d0e0f1017181920212223242526272829303132", "2"]},
{"stub", "foo", ["42"]},
{"stub", "foo", ["-42"]},
{"payable", "foo", ["42"]}
].
not_yet_compilable(fate) ->
[];
not_yet_compilable(aevm) ->
[].

View File

@ -0,0 +1,376 @@
%%% -*- erlang-indent-level:4; indent-tabs-mode: nil -*-
%%%-------------------------------------------------------------------
%%% @copyright (C) 2018, Aeternity Anstalt
%%% @doc Test Sophia language compiler.
%%%
%%% @end
%%%-------------------------------------------------------------------
-module(aeso_compiler_tests).
-compile([export_all, nowarn_export_all]).
-include_lib("eunit/include/eunit.hrl").
%% Very simply test compile the given contracts. Only basic checks
%% are made on the output, just that it is a binary which indicates
%% that the compilation worked.
simple_compile_test_() ->
[ {"Testing the " ++ ContractName ++ " contract with the " ++ atom_to_list(Backend) ++ " backend",
fun() ->
case compile(Backend, ContractName) of
#{byte_code := ByteCode,
contract_source := _,
type_info := _} when Backend == aevm ->
?assertMatch(Code when is_binary(Code), ByteCode);
#{fate_code := Code} when Backend == fate ->
Code1 = aeb_fate_code:deserialize(aeb_fate_code:serialize(Code)),
?assertMatch({X, X}, {Code1, Code});
ErrBin ->
io:format("\n~s", [ErrBin]),
error(ErrBin)
end
end} || ContractName <- compilable_contracts(), Backend <- [aevm, fate],
not lists:member(ContractName, not_yet_compilable(Backend))] ++
[ {"Testing error messages of " ++ ContractName,
fun() ->
case compile(aevm, ContractName) of
<<"Type errors\n", ErrorString/binary>> ->
check_errors(lists:sort(ExpectedErrors), ErrorString);
<<"Parse errors\n", ErrorString/binary>> ->
check_errors(lists:sort(ExpectedErrors), ErrorString)
end
end} ||
{ContractName, ExpectedErrors} <- failing_contracts() ] ++
[ {"Testing include with explicit files",
fun() ->
FileSystem = maps:from_list(
[ begin
{ok, Bin} = file:read_file(filename:join([aeso_test_utils:contract_path(), File])),
{File, Bin}
end || File <- ["included.aes", "../contracts/included2.aes"] ]),
#{byte_code := Code1} = compile(aevm, "include", [{include, {explicit_files, FileSystem}}]),
#{byte_code := Code2} = compile(aevm, "include"),
?assertMatch(true, Code1 == Code2)
end} ] ++
[ {"Testing deadcode elimination for " ++ atom_to_list(Backend),
fun() ->
#{ byte_code := NoDeadCode } = compile(Backend, "nodeadcode"),
#{ byte_code := DeadCode } = compile(Backend, "deadcode"),
SizeNoDeadCode = byte_size(NoDeadCode),
SizeDeadCode = byte_size(DeadCode),
Delta = if Backend == aevm -> 40;
Backend == fate -> 20 end,
?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + Delta < SizeNoDeadCode}),
ok
end} || Backend <- [aevm, fate] ].
check_errors(Expect, ErrorString) ->
%% This removes the final single \n as well.
Actual = binary:split(<<ErrorString/binary,$\n>>, <<"\n\n">>, [global,trim]),
case {Expect -- Actual, Actual -- Expect} of
{[], Extra} -> ?assertMatch({unexpected, []}, {unexpected, Extra});
{Missing, []} -> ?assertMatch({missing, []}, {missing, Missing});
{Missing, Extra} -> ?assertEqual(Missing, Extra)
end.
compile(Backend, Name) ->
compile(Backend, Name,
[{include, {file_system, [aeso_test_utils:contract_path()]}}]).
compile(Backend, Name, Options) ->
String = aeso_test_utils:read_contract(Name),
case aeso_compiler:from_string(String, [{src_file, Name}, {backend, Backend} | Options]) of
{ok, Map} -> Map;
{error, ErrorString} -> ErrorString
end.
%% compilable_contracts() -> [ContractName].
%% The currently compilable contracts.
compilable_contracts() ->
["complex_types",
"counter",
"dutch_auction",
"environment",
"factorial",
"functions",
"fundme",
"identity",
"maps",
"oracles",
"remote_call",
"simple",
"simple_storage",
"spend_test",
"stack",
"test",
"builtin_bug",
"builtin_map_get_bug",
"nodeadcode",
"deadcode",
"variant_types",
"state_handling",
"events",
"include",
"basic_auth",
"bitcoin_auth",
"address_literals",
"bytes_equality",
"address_chain",
"namespace_bug",
"bytes_to_x",
"aens",
"tuple_match",
"cyclic_include",
"stdlib_include",
"double_include",
"manual_stdlib_include",
"list_comp",
"payable"
].
not_yet_compilable(fate) -> [];
not_yet_compilable(aevm) -> [].
%% Contracts that should produce type errors
failing_contracts() ->
[ {"name_clash",
[<<"Duplicate definitions of abort at\n"
" - (builtin location)\n"
" - line 14, column 3">>,
<<"Duplicate definitions of require at\n"
" - (builtin location)\n"
" - line 15, column 3">>,
<<"Duplicate definitions of double_def at\n"
" - line 10, column 3\n"
" - line 11, column 3">>,
<<"Duplicate definitions of double_proto at\n"
" - line 4, column 3\n"
" - line 5, column 3">>,
<<"Duplicate definitions of proto_and_def at\n"
" - line 7, column 3\n"
" - line 8, column 3">>,
<<"Duplicate definitions of put at\n"
" - (builtin location)\n"
" - line 16, column 3">>,
<<"Duplicate definitions of state at\n"
" - (builtin location)\n"
" - line 17, column 3">>]}
, {"type_errors",
[<<"Unbound variable zz at line 17, column 23">>,
<<"Cannot unify int\n"
" and list(int)\n"
"when checking the application at line 26, column 9 of\n"
" (::) : (int, list(int)) => list(int)\n"
"to arguments\n"
" x : int\n"
" x : int">>,
<<"Cannot unify string\n"
" and int\n"
"when checking the assignment of the field\n"
" x : map(string, string) (at line 9, column 48)\n"
"to the old value __x and the new value\n"
" __x {[\"foo\"] @ x = x + 1} : map(string, int)">>,
<<"Cannot unify int\n"
" and string\n"
"when checking the type of the expression at line 34, column 47\n"
" 1 : int\n"
"against the expected type\n"
" string">>,
<<"Cannot unify string\n"
" and int\n"
"when checking the type of the expression at line 34, column 52\n"
" \"bla\" : string\n"
"against the expected type\n"
" int">>,
<<"Cannot unify string\n"
" and int\n"
"when checking the type of the expression at line 32, column 18\n"
" \"x\" : string\n"
"against the expected type\n"
" int">>,
<<"Cannot unify string\n"
" and int\n"
"when checking the type of the expression at line 11, column 58\n"
" \"foo\" : string\n"
"against the expected type\n"
" int">>,
<<"Cannot unify int\n"
" and string\n"
"when comparing the types of the if-branches\n"
" - w : int (at line 38, column 13)\n"
" - z : string (at line 39, column 10)">>,
<<"Not a record type: string\n"
"arising from the projection of the field y (at line 22, column 40)">>,
<<"Not a record type: string\n"
"arising from an assignment of the field y (at line 21, column 44)">>,
<<"Not a record type: string\n"
"arising from an assignment of the field y (at line 20, column 40)">>,
<<"Not a record type: string\n"
"arising from an assignment of the field y (at line 19, column 37)">>,
<<"Ambiguous record type with field y (at line 13, column 27) could be one of\n"
" - r (at line 4, column 10)\n"
" - r' (at line 5, column 10)">>,
<<"Repeated name x in pattern\n"
" x :: x (at line 26, column 7)">>,
<<"Repeated argument x to function repeated_arg (at line 44, column 14).">>,
<<"Repeated argument y to function repeated_arg (at line 44, column 14).">>,
<<"No record type with fields y, z (at line 14, column 24)">>,
<<"The field z is missing when constructing an element of type r2 (at line 15, column 26)">>,
<<"Record type r2 does not have field y (at line 15, column 24)">>,
<<"Let binding at line 47, column 5 must be followed by an expression">>,
<<"Let binding at line 50, column 5 must be followed by an expression">>,
<<"Let binding at line 54, column 5 must be followed by an expression">>,
<<"Let binding at line 58, column 5 must be followed by an expression">>]}
, {"init_type_error",
[<<"Cannot unify string\n"
" and map(int, int)\n"
"when checking that 'init' returns a value of type 'state' at line 7, column 3">>]}
, {"missing_state_type",
[<<"Cannot unify string\n"
" and unit\n"
"when checking that 'init' returns a value of type 'state' at line 5, column 3">>]}
, {"missing_fields_in_record_expression",
[<<"The field x is missing when constructing an element of type r('a) (at line 7, column 42)">>,
<<"The field y is missing when constructing an element of type r(int) (at line 8, column 42)">>,
<<"The fields y, z are missing when constructing an element of type r('a) (at line 6, column 42)">>]}
, {"namespace_clash",
[<<"The contract Call (at line 4, column 10) has the same name as a namespace at (builtin location)">>]}
, {"bad_events",
[<<"The indexed type string (at line 9, column 25) is not a word type">>,
<<"The indexed type alias_string (at line 10, column 25) equals string which is not a word type">>]}
, {"bad_events2",
[<<"The event constructor BadEvent1 (at line 9, column 7) has too many non-indexed values (max 1)">>,
<<"The event constructor BadEvent2 (at line 10, column 7) has too many indexed values (max 3)">>]}
, {"type_clash",
[<<"Cannot unify int\n"
" and string\n"
"when checking the record projection at line 12, column 42\n"
" r.foo : (gas : int, value : int) => Remote.themap\n"
"against the expected type\n"
" (gas : int, value : int) => map(string, int)">>]}
, {"bad_include_and_ns",
[<<"Include of 'included.aes' at line 2, column 11\nnot allowed, include only allowed at top level.">>,
<<"Nested namespace not allowed\nNamespace 'Foo' at line 3, column 13 not defined at top level.">>]}
, {"bad_address_literals",
[<<"The type bytes(32) is not a contract type\n"
"when checking that the contract literal at line 32, column 5\n"
" ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
"has the type\n"
" bytes(32)">>,
<<"The type oracle(int, bool) is not a contract type\n"
"when checking that the contract literal at line 30, column 5\n"
" ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
"has the type\n"
" oracle(int, bool)">>,
<<"The type address is not a contract type\n"
"when checking that the contract literal at line 28, column 5\n"
" ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
"has the type\n"
" address">>,
<<"Cannot unify oracle_query('a, 'b)\n"
" and Remote\n"
"when checking the type of the expression at line 25, column 5\n"
" oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
" oracle_query('a, 'b)\n"
"against the expected type\n"
" Remote">>,
<<"Cannot unify oracle_query('c, 'd)\n"
" and bytes(32)\n"
"when checking the type of the expression at line 23, column 5\n"
" oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
" oracle_query('c, 'd)\n"
"against the expected type\n"
" bytes(32)">>,
<<"Cannot unify oracle_query('e, 'f)\n"
" and oracle(int, bool)\n"
"when checking the type of the expression at line 21, column 5\n"
" oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
" oracle_query('e, 'f)\n"
"against the expected type\n"
" oracle(int, bool)">>,
<<"Cannot unify oracle('g, 'h)\n"
" and Remote\n"
"when checking the type of the expression at line 18, column 5\n"
" ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
" oracle('g, 'h)\n"
"against the expected type\n"
" Remote">>,
<<"Cannot unify oracle('i, 'j)\n"
" and bytes(32)\n"
"when checking the type of the expression at line 16, column 5\n"
" ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
" oracle('i, 'j)\n"
"against the expected type\n"
" bytes(32)">>,
<<"Cannot unify oracle('k, 'l)\n"
" and oracle_query(int, bool)\n"
"when checking the type of the expression at line 14, column 5\n"
" ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
" oracle('k, 'l)\n"
"against the expected type\n"
" oracle_query(int, bool)">>,
<<"Cannot unify address\n"
" and oracle(int, bool)\n"
"when checking the type of the expression at line 11, column 5\n"
" ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt : address\n"
"against the expected type\n"
" oracle(int, bool)">>,
<<"Cannot unify address\n"
" and Remote\n"
"when checking the type of the expression at line 9, column 5\n"
" ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt : address\n"
"against the expected type\n"
" Remote">>,
<<"Cannot unify address\n"
" and bytes(32)\n"
"when checking the type of the expression at line 7, column 5\n"
" ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt : address\n"
"against the expected type\n"
" bytes(32)">>]}
, {"stateful",
[<<"Cannot reference stateful function Chain.spend (at line 13, column 35)\nin the definition of non-stateful function fail1.">>,
<<"Cannot reference stateful function local_spend (at line 14, column 35)\nin the definition of non-stateful function fail2.">>,
<<"Cannot reference stateful function Chain.spend (at line 16, column 15)\nin the definition of non-stateful function fail3.">>,
<<"Cannot reference stateful function Chain.spend (at line 20, column 31)\nin the definition of non-stateful function fail4.">>,
<<"Cannot reference stateful function Chain.spend (at line 35, column 47)\nin the definition of non-stateful function fail5.">>,
<<"Cannot pass non-zero value argument 1000 (at line 48, column 57)\nin the definition of non-stateful function fail6.">>,
<<"Cannot pass non-zero value argument 1000 (at line 49, column 56)\nin the definition of non-stateful function fail7.">>,
<<"Cannot pass non-zero value argument 1000 (at line 52, column 17)\nin the definition of non-stateful function fail8.">>]}
, {"bad_init_state_access",
[<<"The init function should return the initial state as its result and cannot write the state,\n"
"but it calls\n"
" - set_state (at line 11, column 5), which calls\n"
" - roundabout (at line 8, column 38), which calls\n"
" - put (at line 7, column 39)">>,
<<"The init function should return the initial state as its result and cannot read the state,\n"
"but it calls\n"
" - new_state (at line 12, column 5), which calls\n"
" - state (at line 5, column 29)">>,
<<"The init function should return the initial state as its result and cannot read the state,\n"
"but it calls\n"
" - state (at line 13, column 13)">>]}
, {"field_parse_error",
[<<"line 6, column 1: In field_parse_error at 5:26:\n"
"Cannot use nested fields or keys in record construction: p.x\n">>]}
, {"modifier_checks",
[<<"The function all_the_things (at line 11, column 3) cannot be both public and private.">>,
<<"Namespaces cannot contain entrypoints (at line 3, column 3). Use 'function' instead.">>,
<<"The contract Remote (at line 5, column 10) has no entrypoints. Since Sophia version 3.2, public\ncontract functions must be declared with the 'entrypoint' keyword instead of\n'function'.">>,
<<"The entrypoint wha (at line 12, column 3) cannot be private. Use 'function' instead.">>,
<<"Use 'entrypoint' for declaration of foo (at line 6, column 3):\n entrypoint foo : () => unit">>,
<<"Use 'entrypoint' instead of 'function' for public function foo (at line 10, column 3):\n entrypoint foo() = ()">>,
<<"Use 'entrypoint' instead of 'function' for public function foo (at line 6, column 3):\n entrypoint foo : () => unit">>]}
, {"list_comp_not_a_list",
[<<"Cannot unify int\n and list('a)\nwhen checking rvalue of list comprehension binding at line 2, column 36\n 1 : int\nagainst type \n list('a)">>
]}
, {"list_comp_if_not_bool",
[<<"Cannot unify int\n and bool\nwhen checking the type of the expression at line 2, column 44\n 3 : int\nagainst the expected type\n bool">>
]}
, {"list_comp_bad_shadow",
[<<"Cannot unify int\n and string\nwhen checking the type of the pattern at line 2, column 53\n x : int\nagainst the expected type\n string">>
]}
].

22
test/aeso_eunit_SUITE.erl Normal file
View File

@ -0,0 +1,22 @@
-module(aeso_eunit_SUITE).
-compile([export_all, nowarn_export_all]).
-include_lib("common_test/include/ct.hrl").
all() ->
[{group, eunit}].
groups() ->
[{eunit, [], [ aeso_scan_tests
, aeso_parser_tests
, aeso_compiler_tests
, aeso_abi_tests
, aeso_aci_tests
]}].
aeso_scan_tests(_Config) -> ok = eunit:test(aeso_scan_tests).
aeso_parser_tests(_Config) -> ok = eunit:test(aeso_parser_tests).
aeso_compiler_tests(_Config) -> ok = eunit:test(aeso_compiler_tests).
aeso_abi_tests(_Config) -> ok = eunit:test(aeso_abi_tests).
aeso_aci_tests(_Config) -> ok = eunit:test(aeso_aci_tests).

View File

@ -1,23 +1,21 @@
-module(so_parser_tests).
-module(aeso_parser_tests).
-export([parse_contract/1]).
-include_lib("eunit/include/eunit.hrl").
id(X) -> X.
simple_contracts_test_() ->
{foreach,
fun() -> ok end,
fun(_) -> ok end,
[{"Parse a contract with an identity function.",
fun() ->
Text = "main contract Identity =\n"
Text = "contract Identity =\n"
" function id(x) = x\n",
?assertMatch(
[{contract_main, _, {con, _, "Identity"}, _,
[{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"},
[{guarded, _, [], {id, _, "x"}}]}]}], parse_string(Text)),
[{contract, _, {con, _, "Identity"},
[{letfun, _, {id, _, "id"}, [{arg, _, {id, _, "x"}, {id, _, "_"}}], {id, _, "_"},
{id, _, "x"}}]}], parse_string(Text)),
ok
end},
{"Operator precedence test.",
@ -32,7 +30,7 @@ simple_contracts_test_() ->
end,
Parse = fun(S) ->
try remove_line_numbers(parse_expr(S))
catch _:_ -> ?assertMatch(ok, id({parse_fail, S})) end
catch _:_ -> ?assertMatch(ok, {parse_fail, S}) end
end,
CheckParens = fun(Expr) ->
?assertEqual(Parse(NoPar(Expr)), Parse(Par(Expr)))
@ -40,7 +38,8 @@ simple_contracts_test_() ->
LeftAssoc = fun(Op) -> CheckParens({{a, Op, b}, Op, c}) end,
RightAssoc = fun(Op) -> CheckParens({a, Op, {b, Op, c}}) end,
NonAssoc = fun(Op) ->
?assertThrow({error, [_]},
OpAtom = list_to_atom(Op),
?assertError({error, {_, parse_error, _}},
parse_expr(NoPar({a, Op, {b, Op, c}}))) end,
Stronger = fun(Op1, Op2) ->
CheckParens({{a, Op1, b}, Op2, c}),
@ -53,7 +52,7 @@ simple_contracts_test_() ->
%% associativity
[ RightAssoc(Op) || Op <- ["||", "&&", "::", "++"] ],
[ NonAssoc(Op) || Op <- ["==", "!=", "<", ">", "=<", ">="] ],
[ LeftAssoc(Op) || Op <- ["+", "-", "*", "/", "mod", "band", "bor", "bxor", "<<", ">>"] ],
[ LeftAssoc(Op) || Op <- ["+", "-", "*", "/", "mod"] ],
%% precedence
[ Stronger(Op2, Op1) || [T1 , T2 | _] <- tails(Tiers), Op1 <- T1, Op2 <- T2 ],
@ -63,30 +62,32 @@ simple_contracts_test_() ->
%% Parse tests of example contracts
[ {lists:concat(["Parse the ", Contract, " contract."]),
fun() -> roundtrip_contract(Contract) end}
|| Contract <- [counter, voting, all_syntax, '05_greeter', aeproof,
multi_sig, simple_storage, fundme, dutch_auction, utf8] ]
|| Contract <- [counter, voting, all_syntax, '05_greeter', aeproof, multi_sig, simple_storage, fundme, dutch_auction] ]
}.
parse_contract(Name) ->
parse_string(so_test_utils:read_contract(Name)).
parse_string(aeso_test_utils:read_contract(Name)).
roundtrip_contract(Name) ->
round_trip(so_test_utils:read_contract(Name)).
round_trip(aeso_test_utils:read_contract(Name)).
parse_string(Text) -> parse_string(Text, []).
parse_string(Text, Opts) ->
so_parser:string(Text, Opts).
case aeso_parser:string(Text, Opts) of
{ok, Contract} -> Contract;
Err -> error(Err)
end.
parse_expr(Text) ->
[{letval, _, _, Expr}] =
[{letval, _, _, _, Expr}] =
parse_string("let _ = " ++ Text),
Expr.
round_trip(Text) ->
Contract = parse_string(Text),
Text1 = prettypr:format(so_pretty:decls(strip_stdlib(Contract))),
Contract1 = parse_string(so_scan:utf8_encode(Text1)),
Text1 = prettypr:format(aeso_pretty:decls(strip_stdlib(Contract))),
Contract1 = parse_string(Text1),
NoSrcLoc = remove_line_numbers(Contract),
NoSrcLoc1 = remove_line_numbers(Contract1),
?assertMatch(NoSrcLoc, diff(NoSrcLoc, NoSrcLoc1)).

View File

@ -1,4 +1,4 @@
-module(so_scan_tests).
-module(aeso_scan_tests).
-include_lib("eunit/include/eunit.hrl").
@ -13,7 +13,7 @@ empty_contract_test_() ->
[{"Scan an empty contract.",
fun() ->
Text = " ",
{ok, []} = so_scan:scan(Text),
{ok, []} = aeso_scan:scan(Text),
ok
end}
]}.
@ -26,7 +26,7 @@ all_tokens_test_() ->
Tokens = all_tokens(),
Text = string:join(lists:map(fun show_token/1, Tokens), " "),
io:format("~s\n", [Text]),
{ok, Tokens1} = so_scan:scan(Text),
{ok, Tokens1} = aeso_scan:scan(Text),
true = compare_tokens(Tokens, Tokens1),
ok
end}
@ -39,8 +39,7 @@ all_tokens() ->
%% Symbols
lists:map(Lit, [',', '.', ';', '|', ':', '(', ')', '[', ']', '{', '}']) ++
%% Operators
lists:map(Lit, ['=', '==', '!=', '>', '<', '>=', '=<', '-', '+', '++', '*', '/', mod,
':', '::', '->', '=>', '||', '&&', '!', 'band', 'bor', 'bxor', 'bnot' ,'<<', '>>']) ++
lists:map(Lit, ['=', '==', '!=', '>', '<', '>=', '=<', '-', '+', '++', '*', '/', mod, ':', '::', '->', '=>', '||', '&&', '!']) ++
%% Keywords
lists:map(Lit, [contract, type, 'let', switch]) ++
%% Comment token (not an actual token), just for tests

View File

@ -6,12 +6,12 @@
%%% @end
%%%-------------------------------------------------------------------
-module(so_test_utils).
-module(aeso_test_utils).
-export([read_contract/1, contract_path/0]).
contract_path() ->
filename:join(code:lib_dir(sophia, test), "contracts").
filename:join(code:lib_dir(aesophia, test), "contracts").
%% Read a contract file from the test/contracts directory.
-spec read_contract(string() | atom()) -> string().

View File

@ -58,7 +58,8 @@ contract Greeter =
let state = { greeting = "Hello" }
function setGreeting(greeting: string) =
let setGreeting =
(greeting: string) =>
state{ greeting = greeting }

15
test/contracts/Makefile Normal file
View File

@ -0,0 +1,15 @@
## Requires ocaml >= 4.02, < 4.06
## and reason-3.0.0 (opam install reason).
default : voting_test
%.ml : %.re
refmt -p ml $< > $@
voting_test : rte.ml voting.ml voting_test.ml
ocamlopt -o $@ $^
clean :
rm -f *.cmi *.cmx *.ml *.o voting_test

View File

@ -1,5 +1,5 @@
contract Identity =
function main_fun (x:int) = x
function main (x:int) = x
function __call() = 12

View File

@ -0,0 +1,31 @@
// A simple test of the abort built-in function.
contract AbortTest =
record state = { value : int }
public function init(v : int) =
{ value = v }
// Aborting
public function do_abort(v : int, s : string) : unit =
put_value(v)
revert_abort(s)
// Accessing the value
public function get_value() = state.value
public function put_value(v : int) = put(state{value = v})
public function get_values() : list(int) = [state.value]
public function put_values(v : int) = put(state{value = v})
// Some basic statistics
public function get_stats(acct : address) =
( Contract.balance, Chain.balance(acct) )
// Abort functions.
private function revert_abort(s : string) =
abort(s)
// This is still legal but will be stripped out.
// TODO: This function confuses the type inference, so it cannot be present.
//private function abort(s : string) = 42

View File

@ -0,0 +1,27 @@
contract Interface =
function do_abort : (int, string) => unit
function get_value : () => int
function put_value : (int) => unit
function get_values : () => list(int)
function put_values : (int) => unit
contract AbortTestInt =
record state = {r : Interface, value : int}
public function init(r : Interface, value : int) =
{r = r, value = value}
// Aborting
public function do_abort(v : int, s : string) =
put_value(v)
state.r.do_abort(v + 100, s)
// Accessing the value
public function put_value(v : int) = put(state{value = v})
public function get_value() = state.value
public function get_values() : list(int) =
state.value :: state.r.get_values()
public function put_values(v : int) =
put_value(v)
state.r.put_values(v + 1000)

View File

@ -1,13 +1,28 @@
contract interface Remote =
entrypoint main_fun : (int) => unit
contract Remote =
entrypoint main : (int) => unit
contract AddrChain =
type o_type = oracle(string, map(string, int))
type oq_type = oracle_query(string, map(string, int))
entrypoint is_o(a : address) =
Address.is_oracle(a)
entrypoint is_c(a : address) =
Address.is_contract(a)
// entrypoint get_o(a : address) : option(o_type) =
// Address.get_oracle(a)
// entrypoint get_c(a : address) : option(Remote) =
// Address.get_contract(a)
entrypoint check_o(o : o_type) =
Oracle.check(o)
entrypoint check_oq(o : o_type, oq : oq_type) =
Oracle.check_query(o, oq)
// entrypoint h_to_i(h : hash) : int =
// Hash.to_int(h)

View File

@ -1,12 +1,14 @@
contract interface Remote =
contract Remote =
entrypoint foo : () => unit
contract AddressLiterals =
entrypoint addr() : address =
ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
entrypoint oracle() : oracle(int, bool) =
ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5
entrypoint query() : oracle_query(int, bool) =
oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY
entrypoint contr() : Remote =
ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ
entrypoint contr_addr() : Remote =
Address.to_contract(addr())

View File

@ -1,76 +1,68 @@
contract C = entrypoint init() = ()
// AENS tests
main contract AENSTest =
contract AENSTest =
type subnames = map(string, map(string, address))
// Name resolution
stateful entrypoint resolve_word(name : string, key : string) : option(address) =
AENSv2.resolve(name, key)
AENS.resolve(name, key)
stateful entrypoint resolve_string(name : string, key : string) : option(string) =
AENSv2.resolve(name, key)
stateful entrypoint resolve_contract(name : string, key : string) : option(C) =
AENSv2.resolve(name, key)
AENS.resolve(name, key)
// Transactions
stateful entrypoint preclaim(addr : address, // Claim on behalf of this account (can be Contract.address)
chash : hash) : unit = // Commitment hash
AENSv2.preclaim(addr, chash)
chash : hash) : unit = // Commitment hash
AENS.preclaim(addr, chash)
stateful entrypoint signedPreclaim(addr : address, // Claim on behalf of this account (can be Contract.address)
chash : hash, // Commitment hash
sign : signature) : unit = // Signed by addr (if not Contract.address)
AENSv2.preclaim(addr, chash, signature = sign)
AENS.preclaim(addr, chash, signature = sign)
stateful entrypoint claim(addr : address,
name : string,
salt : int,
name_fee : int) : unit =
AENSv2.claim(addr, name, salt, name_fee)
salt : int) : unit =
AENS.claim(addr, name, salt)
stateful entrypoint signedClaim(addr : address,
name : string,
salt : int,
name_fee : int,
sign : signature) : unit =
AENSv2.claim(addr, name, salt, name_fee, signature = sign)
stateful entrypoint update(owner : address,
name : string,
ttl : option(Chain.ttl),
client_ttl : option(int),
pointers : option(map(string, AENSv2.pointee))) : unit =
AENSv2.update(owner, name, ttl, client_ttl, pointers)
stateful entrypoint signedUpdate(owner : address,
name : string,
ttl : option(Chain.ttl),
client_ttl : option(int),
pointers : option(map(string, AENSv2.pointee)),
sign : signature) : unit =
AENSv2.update(owner, name, ttl, client_ttl, pointers, signature = sign)
AENS.claim(addr, name, salt, signature = sign)
// TODO: update() -- how to handle pointers?
stateful entrypoint transfer(owner : address,
new_owner : address,
name : string) : unit =
AENSv2.transfer(owner, new_owner, name)
AENS.transfer(owner, new_owner, name)
stateful entrypoint signedTransfer(owner : address,
new_owner : address,
name : string,
sign : signature) : unit =
AENSv2.transfer(owner, new_owner, name, signature = sign)
AENS.transfer(owner, new_owner, name, signature = sign)
stateful entrypoint revoke(owner : address,
name : string) : unit =
AENSv2.revoke(owner, name)
AENS.revoke(owner, name)
stateful entrypoint signedRevoke(owner : address,
name : string,
sign : signature) : unit =
AENSv2.revoke(owner, name, signature = sign)
AENS.revoke(owner, name, signature = sign)
stateful entrypoint subname(owner : address,
name : string,
subnames : subnames) : unit =
AENS.subname(owner, name, subnames)
stateful entrypoint signedSubname(owner : address,
name : string,
subnames : subnames,
sign : signature) : unit =
AENS.subname(owner, name, subnames, signature = sign)

View File

@ -1,29 +0,0 @@
include "Option.aes"
include "String.aes"
include "AENSCompat.aes"
contract interface OldAENSContract =
entrypoint set : (string, string, AENS.pointee) => unit
entrypoint lookup : (string, string) => AENS.pointee
main contract AENSUpdate =
stateful entrypoint update_name(owner : address, name : string, b : bytes(2)) =
let p1 : AENSv2.pointee = AENSv2.AccountPt(Call.caller)
let p2 : AENSv2.pointee = AENSv2.OraclePt(Call.caller)
let p3 : AENSv2.pointee = AENSv2.ContractPt(Call.caller)
let p4 : AENSv2.pointee = AENSv2.ChannelPt(Call.caller)
let p5 : AENSv2.pointee = AENSv2.DataPt(String.to_bytes("any something will do"))
let p6 : AENSv2.pointee = AENSv2.DataPt(Int.to_bytes(1345, 4))
AENSv2.update(owner, name, None, None,
Some({ ["account_pubkey"] = p1,
["contract_pubkey"] = p3, ["misc"] = p4, ["data"] = p5, ["data2"] = p6 }))
stateful entrypoint old_interaction(c : OldAENSContract, owner : address, name : string) =
let p : AENS.pointee = c.lookup(name, "key1")
AENSv2.update(owner, name, None, None, Some({ ["key1"] = AENSCompat.pointee_to_V2(p) }))
switch(AENSv2.lookup(name))
Some(AENSv2.Name(_, _, pt_map)) =>
c.set(name, "key2", Option.force(AENSCompat.pointee_from_V2(pt_map["key1"])))
entrypoint get_ttl(name : string) =
switch(AENSv2.lookup(name))
Some(AENSv2.Name(_, FixedTTL(ttl), _)) => ttl

View File

@ -1,86 +1,44 @@
// Try to cover all syntactic constructs.
@compiler > 0
@compiler =< 10.1.1.1.1.1.2.3.4
contract AllSyntaxType =
type typeDecl /* bla */
type paramTypeDecl('a, 'b)
namespace Ns =
datatype d('a) = D | S(int) | M('a, list('a), int)
private function fff() = 123
let const = 1
stateful entrypoint
f (1, x) = (_) => x
payable contract AllSyntaxType =
/** Multi-
* line
* comment
*/
stateful function foo : _
entrypoint bar : int => (int * 'a)
function foo : _
contract AllSyntax =
datatype mickiewicz = Adam | Mickiewicz
record goethe('a, 'b) = {
johann : int,
wolfgang : 'a,
von : 'a * 'b * int,
goethe : unit
}
type dante = Ns.d(int)
type shakespeare('a) = goethe('a, 'a)
type typeDecl = int
type paramTypeDecl('a, 'b) = (('a, 'b) => 'b) => list('a) => 'b => 'b
type state = shakespeare(int)
record nestedRecord = { x : int }
record recordType = { z : nestedRecord, y : int }
datatype variantType('a) = None | Some('a)
let cc = "str"
let valWithType : map(int, int) => option(int) = (m) => Map.get(m, 42)
let valNoType =
if(valWithType(Map.empty) == None)
print(42 mod 10 * 5 / 3)
entrypoint init() = {
johann = 1000,
wolfgang = -10,
function funWithType(x : int, y) : int * list(int) = (x, 0 :: [y] ++ [])
function funNoType() =
let foo = (x, y : bool) =>
if (! (y && x =< 0x0b || true)) [x]
else [11..20]
let setY(r : recordType) : unit = r{ y = 5 }
let setX(r : recordType, x : int) : recordType = r { z.x = x } // nested record update
let getY(r) = switch(r) {y = y} => y
switch (funWithType(1, -2))
(x, [y, z]) => bar({x = z, y = -y + - -z * (-1)})
(x, y :: _) => ()
/* TODO: This does not compile because of bug in the parser tester.
von = (2 + 2, 0, List.sum([x | k <- [1,2,3]
, let l = k + 1
, if(l < 10)
, let f(x) = x + 100
, Adam <- [Adam, Mickiewicz]
, let x = f(l)
])),
*/
von = (2 + 2, 0, List.sum([1,2,3,4])),
goethe = () }
let hash : address = #01ab0fff11
let b = false
let qcon = Mod.Con
let str = "blabla\nfoo"
let chr = '"'
function f() =
let kp = "nietzsche"
// let p = "Пушкин" // TODO: this also doesn't do right round_trip...
let k(x : bytes(8)) : bytes(8) = Bytes.to_int(#fedcba9876543210)
let f : () => address = () => ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
if(Bits.test(Bits.all, 10))
abort("ohno")
if(true && false)
require(true, "ohyes")
elif(false || 2 == 2)
()
else
()
if(true) f(1,2)((1,2))
else switch(1::[1,2,3])
[] => 1
a::b => 123
1::2::3 => 123123
[2,3,4] => 1
_ => 13
1::[2] => 2138
put(state{johann = 1})
let m = {["foo"] = 19, /*hey wanna talk about inlined comments?*/ ["bar"] = 42}
let n = {}
m{ ["x" = 0] @ z = z + state.johann }
let sh : shakespeare(shakespeare(int)) =
{wolfgang = state}
sh{wolfgang.wolfgang = sh.wolfgang} // comment
exit("hope you had fun reading this")

View File

@ -1,5 +0,0 @@
contract C =
entrypoint f() = 123
contract D =
entrypoint f() = 123

View File

@ -1,4 +0,0 @@
contract AssignPatternToPattern =
entrypoint f() =
let x::(t::z = y) = [1, 2, 3]
(x + t)::y

View File

@ -1,16 +0,0 @@
include "List.aes"
contract AssignPatterns =
entrypoint test() = foo([1, 0, 2], (2, Some(3)), Some([4, 5]))
entrypoint foo(xs : list(int), p : int * option(int), some : option(list(int))) =
let x::(t = y::_) = xs
let z::_ = t
let (a, (o = Some(b))) = p
let Some((f = g::_)) = some
g + List.get(1, f)
x + y + z + a + b

View File

@ -1,5 +1,5 @@
contract interface Remote =
contract Remote =
entrypoint foo : () => unit
contract AddressLiterals =
@ -7,11 +7,27 @@ contract AddressLiterals =
ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
entrypoint addr2() : Remote =
ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
entrypoint addr3() : oracle(int, bool) =
ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
entrypoint oracle1() : oracle_query(int, bool) =
ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5
entrypoint oracle2() : bytes(32) =
ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5
entrypoint oracle3() : Remote =
ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5
entrypoint query1() : oracle(int, bool) =
oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY
entrypoint query2() : bytes(32) =
oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY
entrypoint query3() : Remote =
oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY
entrypoint contr1() : address =
ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ
entrypoint contr2() : oracle(int, bool) =
ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ
entrypoint contr3() : bytes(32) =
ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ
entrypoint contr4() : address =
Address.to_contract(Contract.address)

View File

@ -1,9 +0,0 @@
contract BadAENSresolve =
type t('a) = option(list('a))
function fail() : t(int) =
AENSv2.resolve("foo.aet", "whatever")
entrypoint main_fun() = ()

View File

@ -1,9 +0,0 @@
contract BadAENSresolve =
using AENSv2
type t('a) = option(list('a))
function fail() : t(int) =
resolve("foo.aet", "whatever")
entrypoint main_fun() = ()

View File

@ -1,4 +0,0 @@
contract C =
type id('a) = 'a
entrypoint f() : id = 123
entrypoint g() : id(int, int) = 123

View File

@ -1,19 +0,0 @@
contract BytesConcat =
entrypoint test1(x : bytes(10), y : bytes(20)) =
Bytes.concat(x, y)
entrypoint test2(x : bytes(10), y) : bytes(15) =
Bytes.concat(x, y)
entrypoint test3(x, y : bytes(20)) : bytes(25) =
Bytes.concat(x, y)
entrypoint fail1(x, y) : bytes(10) = Bytes.concat(x, y)
entrypoint fail2(x, y) = Bytes.concat(x, y)
entrypoint fail3(x : bytes(6), y : bytes(20)) : bytes(25) =
Bytes.concat(x, y)
entrypoint fail4(x : bytes(6), y) : _ =
Bytes.concat(x, y)
entrypoint fail5(x) = Bytes.to_str(x)

View File

@ -1,20 +0,0 @@
contract BytesSplit =
entrypoint test1(x) : bytes(10) * bytes(20) =
Bytes.split(x)
entrypoint test2(x : bytes(15)) : bytes(10) * _ =
Bytes.split(x)
entrypoint test3(x : bytes(25)) : _ * bytes(20) =
Bytes.split(x)
entrypoint fail1(x) : _ * bytes(20) =
Bytes.split(x)
entrypoint fail2(x : bytes(15)) : _ =
Bytes.split(x)
entrypoint fail3(x) : bytes(20) * _ =
Bytes.split(x)

View File

@ -1,5 +0,0 @@
// include "String.aes"
contract BytesToX =
entrypoint fail1(b : bytes()) = Bytes.to_fixed_size(b)
entrypoint fail2(b : bytes(4)) = Bytes.to_fixed_size(b)
entrypoint fail3(b : bytes()) = Bytes.to_any_size(b)

View File

@ -1,5 +0,0 @@
contract C =
function
g(1) = 2
f(2) = 3
h(1) = 123

View File

@ -1,4 +1,5 @@
contract BadCon =
contract Bad =
include "included.aes"
namespace Foo =
function foo() = 42

View File

@ -1,6 +0,0 @@
contract Test =
entrypoint f() = ()
entrypoint g(x : int, y : string) = f(1)
entrypoint h() = g(1)
entrypoint i() = g("Litwo, ojczyzno moja")

View File

@ -1,6 +0,0 @@
contract interface Remote =
entrypoint id : int => int
contract ProtectedCall =
entrypoint bad(r : Remote) =
r.id(protected = 0 == 1, 18)

View File

@ -1,5 +0,0 @@
contract BadRecord =
entrypoint foo() =
let r = {x = 0, [0] = 1}
r{x = 0, [0] = 1}
r{}

Some files were not shown because too many files have changed in this diff Show More