diff --git a/.github/workflows/requirements.txt b/.github/workflows/requirements.txt index a181433..dcdee61 100644 --- a/.github/workflows/requirements.txt +++ b/.github/workflows/requirements.txt @@ -1,5 +1,5 @@ -mkdocs==1.2.4 +mkdocs==1.4.2 mkdocs-simple-hooks==0.1.5 -mkdocs-material==7.3.6 +mkdocs-material==9.0.9 mike==1.1.2 -pygments==2.12.0 \ No newline at end of file +pygments==2.14.0 \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index fa9e081..d04f3bf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,8 +4,47 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [CERES 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(string)`. 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. +### Changed +### Removed +- `Bitwise.aes` standard library is removed - the builtin operations are superior. + ## [Unreleased] ### Added +### Changed +### Removed +### Fixed + +## [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 ``` @@ -14,9 +53,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 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. -### Removed +- 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. @@ -371,7 +413,9 @@ 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/v7.0.1...HEAD +[Unreleased]: https://github.com/aeternity/aesophia/compare/v7.2.0...HEAD +[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 diff --git a/docs/aeso_compiler.md b/docs/aeso_compiler.md index 61ee7aa..4798ad4 100644 --- a/docs/aeso_compiler.md +++ b/docs/aeso_compiler.md @@ -53,8 +53,6 @@ The **pp_** options all print to standard output the following: 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. -The option `debug_info` includes information related to debugging in the compiler output. Currently this option only includes the mapping from variables to registers. - #### Options to control which compiler optimizations should run: By default all optimizations are turned on, to disable an optimization, it should be diff --git a/docs/sophia_features.md b/docs/sophia_features.md index 68ac6fa..66431e9 100644 --- a/docs/sophia_features.md +++ b/docs/sophia_features.md @@ -191,6 +191,17 @@ contract interface X : Z = entrypoint z() = 1 ``` +#### Adding or removing modifiers + +When a `contract` or a `contract interface` implements another `contract interface`, the `payable` and `stateful` modifiers can be kept or changed, both in the contract and in the entrypoints, according to the following rules: + +1. A `payable` contract or interface can implement a `payable` interface or a non-`payable` interface. +2. A non-`payable` contract or interface can only implement a non-`payable` interface, and cannot implement a `payable` interface. +3. A `payable` entrypoint can implement a `payable` entrypoint or a non-`payable` entrypoint. +4. A non-`payable` entrypoint can only implement a non-`payable` entrypoint, and cannot implement a `payable` entrypoint. +5. A non-`stateful` entrypoint can implement a `stateful` entrypoint or a non-`stateful` entrypoint. +6. A `stateful` entrypoint can only implement a `stateful` entrypoint, and cannot implement a non-`stateful` entrypoint. + #### Subtyping and variance Subtyping in Sophia follows common rules that take type variance into account. As described by [Wikipedia](https://en.wikipedia.org/wiki/Covariance_and_contravariance_(computer_science)), @@ -245,10 +256,10 @@ datatype bi('a) = Bi // bi is bivariant on 'a The following facts apply here: -- `co('a)` is a subtype of `co('b) when `'a` is a subtype of `'b` -- `ct('a)` is a subtype of `ct('b) when `'b` is a subtype of `'a` -- `in('a)` is a subtype of `in('b) when `'a` is equal to `'b` -- `bi('a)` is a subtype of `bi('b) always +- `co('a)` is a subtype of `co('b)` when `'a` is a subtype of `'b` +- `ct('a)` is a subtype of `ct('b)` when `'b` is a subtype of `'a` +- `in('a)` is a subtype of `in('b)` when `'a` is equal to `'b` +- `bi('a)` is a subtype of `bi('b)` always That altogether induce the following rules of subtyping in Sophia: @@ -549,6 +560,45 @@ Sophia has the following types: | oracle_query('a, 'b) | `oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY` | | contract | `ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ` | +## Hole expression + +Hole expressions, written as `???`, are expressions that are used as a placeholder. During compilation, the compiler will generate a type error indication the type of the hole expression. + +``` +include "List.aes" +contract C = + entrypoint f() = + List.sum(List.map(???, [1,2,3])) +``` + +A hole expression found in the example above will generate the error `` Found a hole of type `(int) => int` ``. This says that the compiler expects a function from `int` to `int` in place of the `???` placeholder. + +## Constants + +Constants in Sophia are contract-level bindings that can be used in either contracts or namespaces. The value of a constant can be a literal, another constant, or arithmetic operations applied to other constants. Lists, tuples, maps, and records can also be used to define a constant as long as their elements are also constants. + +The following visibility rules apply to constants: +* Constants defined inside a contract are private in that contract. Thus, cannot be accessed through instances of their defining contract. +* Constants defined inside a namespace are public. Thus, can be used in other contracts or namespaces. +* Constants cannot be defined inside a contract interface. + +When a constant is shadowed, it can be accessed using its qualified name: + +``` +contract C = + let c = 1 + entrypoint f() = + let c = 2 + c + C.c // the result is 3 +``` + +The name of the constant must be an id; therefore, no pattern matching is allowed when defining a constant: + +``` +contract C + let x::y::_ = [1,2,3] // this will result in an error +``` + ## Arithmetic Sophia integers (`int`) are represented by arbitrary-sized signed words and support the following @@ -564,6 +614,14 @@ All operations are *safe* with respect to overflow and underflow. The division and modulo operations throw an arithmetic error if the right-hand operand is zero. +Sophia arbitrary-sized integers (FATE) also supports the following bitwise operations: +- bitwise and (`x band y`) +- bitwise or (`x bor y`) +- bitwise xor (`x bxor y`) +- bitwise not (`bnot x`) +- arithmetic bitshift left (`x << n`) +- arithmetic bitshift right (`x >> n`) + ## Bit fields Sophia integers do not support bit arithmetic. Instead there is a separate diff --git a/docs/sophia_stdlib.md b/docs/sophia_stdlib.md index 6c5cd52..cc49e85 100644 --- a/docs/sophia_stdlib.md +++ b/docs/sophia_stdlib.md @@ -14,6 +14,7 @@ The out-of-the-box namespaces are: - [Address](#address) - [AENS](#aens) +- [AENSv2](#aensv2) - [Auth](#auth) - [Bits](#bits) - [Bytes](#bytes) @@ -31,6 +32,7 @@ The following ones need to be included as regular files with `.aes` suffix, for include "List.aes" ``` +- [AENSCompat](#aenscompat) - [Bitwise](#bitwise) - [BLS12_381](#bls12_381) - [Func](#func) @@ -90,13 +92,10 @@ Cast address to contract type C (where `C` is a contract) ### AENS -The following functionality is available for interacting with the æternity -naming system (AENS). -If `owner` is equal to `Contract.address` the signature `signature` is -ignored, and can be left out since it is a named argument. Otherwise we need -a signature to prove that we are allowed to do AENS operations on behalf of -`owner`. The [signature is tied to a network id](https://github.com/aeternity/protocol/blob/iris/consensus/consensus.md#transaction-signature), -i.e. the signature material should be prefixed by the network id. +The old AENS namespace, kept in the compiler to be able to interact with +contracts from before Ceres, compiled using aesophia compiler version 7.x and +earlier. Used in [AENSCompat](#aenscompat) when converting between old and new +pointers. #### Types @@ -113,12 +112,41 @@ datatype pointee = AccountPt(address) | OraclePt(address) | ContractPt(address) | ChannelPt(address) ``` +### AENSv2 + +Note: introduced in v8.0 + +The following functionality is available for interacting with the æternity +naming system (AENS). If `owner` is equal to `Contract.address` the signature +`signature` is ignored, and can be left out since it is a named argument. +Otherwise we need a signature to prove that we are allowed to do AENS +operations on behalf of `owner`. The [signature is tied to a network +id](https://github.com/aeternity/protocol/blob/iris/consensus/consensus.md#transaction-signature), +i.e. the signature material should be prefixed by the network id. + +#### Types + +##### name +``` +datatype name = Name(address, Chain.ttl, map(string, AENSv2.pointee)) +``` + + +##### pointee + +``` +datatype pointee = AccountPt(address) | OraclePt(address) + | ContractPt(address) | ChannelPt(address) | DataPt(string) +``` + +Note: on-chain there is a maximum length enforced for `DataPt`, it is 1024 bytes. +Sophia itself does _not_ enforce this. #### Functions ##### resolve ``` -AENS.resolve(name : string, key : string) : option('a) +AENSv2.resolve(name : string, key : string) : option('a) ``` Name resolution. Here `name` should be a registered name and `key` one of the attributes @@ -129,41 +157,53 @@ type checked against this type at run time. ##### lookup ``` -AENS.lookup(name : string) : option(AENS.name) +AENSv2.lookup(name : string) : option(AENSv2.name) ``` -If `name` is an active name `AENS.lookup` returns a name object. +If `name` is an active name `AENSv2.lookup` returns a name object. The three arguments to `Name` are `owner`, `expiry` and a map of the `pointees` for the name. Note: the expiry of the name is always a fixed TTL. For example: ``` -let Some(Name(owner, FixedTTL(expiry), ptrs)) = AENS.lookup("example.chain") +let Some(AENSv2.Name(owner, FixedTTL(expiry), ptrs)) = AENSv2.lookup("example.chain") ``` +Note: Changed to produce `AENSv2.name` in v8.0 (Ceres protocol upgrade). ##### preclaim ``` -AENS.preclaim(owner : address, commitment_hash : hash, ) : unit +AENSv2.preclaim(owner : address, commitment_hash : hash, ) : unit ``` The [signature](./sophia_features.md#delegation-signature) should be over `network id` + `owner address` + `Contract.address` (concatenated as byte arrays). +From Ceres (i.e. FATE VM version 3) the +[signature](./sophia_features.md#delegation-signature) can also be generic +(allowing _all_, existing and future, names to be delegated with one +signature), i.e. over `network id` + `owner address` + `string "AENS"` + +`Contract.address`. + ##### claim ``` -AENS.claim(owner : address, name : string, salt : int, name_fee : int, ) : unit +AENSv2.claim(owner : address, name : string, salt : int, name_fee : int, ) : unit ``` The [signature](./sophia_features.md#delegation-signature) should be over -`network id` + `owner address` + `name_hash` + `Contract.address` -(concatenated as byte arrays) -using the private key of the `owner` account for signing. +`network id` + `owner address` + `name_hash` + `Contract.address` (concatenated +as byte arrays) using the private key of the `owner` account for signing. + +From Ceres (i.e. FATE VM version 3) the +[signature](./sophia_features.md#delegation-signature) can also be generic +(allowing _all_, existing and future, names to be delegated with one +signature), i.e. over `network id` + `owner address` + `string "AENS"` + +`Contract.address`. ##### transfer ``` -AENS.transfer(owner : address, new_owner : address, name : string, ) : unit +AENSv2.transfer(owner : address, new_owner : address, name : string, ) : unit ``` Transfers name to the new owner. @@ -173,10 +213,16 @@ The [signature](./sophia_features.md#delegation-signature) should be over (concatenated as byte arrays) using the private key of the `owner` account for signing. +From Ceres (i.e. FATE VM version 3) the +[signature](./sophia_features.md#delegation-signature) can also be generic +(allowing _all_, existing and future, names to be delegated with one +signature), i.e. over `network id` + `owner address` + `string "AENS"` + +`Contract.address`. + ##### revoke ``` -AENS.revoke(owner : address, name : string, ) : unit +AENSv2.revoke(owner : address, name : string, ) : unit ``` Revokes the name to extend the ownership time. @@ -186,17 +232,24 @@ The [signature](./sophia_features.md#delegation-signature) should be over (concatenated as byte arrays) using the private key of the `owner` account for signing. +From Ceres (i.e. FATE VM version 3) the +[signature](./sophia_features.md#delegation-signature) can also be generic +(allowing _all_, existing and future, names to be delegated with one +signature), i.e. over `network id` + `owner address` + `string "AENS"` + +`Contract.address`. + ##### update ``` -AENS.update(owner : address, name : string, expiry : option(Chain.ttl), client_ttl : option(int), - new_ptrs : map(string, AENS.pointee), ) : unit +AENSv2.update(owner : address, name : string, expiry : option(Chain.ttl), client_ttl : option(int), + new_ptrs : option(map(string, AENSv2.pointee)), ) : unit ``` Updates the name. If the optional parameters are set to `None` that parameter will not be updated, for example if `None` is passed as `expiry` the expiry block of the name is not changed. +Note: Changed to consume `AENSv2.pointee` in v8.0 (Ceres protocol upgrade). ### Auth @@ -236,7 +289,10 @@ namespace Chain = Auth.tx_hash : option(hash) ``` -Gets the transaction hash during authentication. +Gets the transaction hash during authentication. Note: `Auth.tx_hash` +computation differs between protocol versions (changed in Ceres!), see +[aeserialisation](https://github.com/aeternity/protocol/blob/master/serializations.md) +specification for details. ### Bits @@ -381,6 +437,12 @@ Call.gas_price : int The gas price of the current call. +#### mulmod +``` +Int.mulmod : (a : int, b : int, q : int) : int +``` + +Combined multiplication and modulus, returns `(a * b) mod q`. #### fee ``` @@ -469,37 +531,12 @@ Chain.block_height : int" The height of the current block (i.e. the block in which the current call will be included). - -##### coinbase +#### to_bytes ``` -Chain.coinbase : address +Address.to_bytes(a : address) : bytes(32) ``` -The address of the account that mined the current block. - - -##### timestamp -``` -Chain.timestamp : int -``` - -The timestamp of the current block. - - -##### difficulty -``` -Chain.difficulty : int -``` - -The difficulty of the current block. - - -##### gas -``` -Chain.gas_limit : int -``` - -The gas limit of the current block. +The binary representation of the address. ##### bytecode_hash @@ -538,6 +575,13 @@ charging the calling contract. Note that this won't be visible in `Call.value` in the `init` call of the new contract. It will be included in `Contract.balance`, however. +#### poseidon +``` +Crypto.poseidon(x1 : int, x2 : int) : int +``` + +Hash two integers (in the scalar field of BLS12-381) to another integer (in the scalar +field of BLS12-281). This is a ZK/SNARK-friendly hash function. The type `'c` must be instantiated with a contract. @@ -565,6 +609,7 @@ main contract Market = The typechecker must be certain about the created contract's type, so it is worth writing it explicitly as shown in the example. + ##### clone ``` Chain.clone : ( ref : 'c, gas : int, value : int, protected : bool, ... @@ -623,11 +668,54 @@ implementation of the `init` function does not actually return `state`, but calls `put` instead. Moreover, FATE prevents even handcrafted calls to `init`. +##### coinbase +``` +Chain.coinbase : address +``` + +The address of the account that mined the current block. + + +##### difficulty +``` +Chain.difficulty : int +``` + +The difficulty of the current block. + + ##### event ``` Chain.event(e : event) : unit ``` -Emits the event. To use this function one needs to define the `event` type as a `datatype` in the contract. + +Emits the event. To use this function one needs to define the `event` type as a +`datatype` in the contract. + + +##### gas\_limit +``` +Chain.gas_limit : int +``` + +The gas limit of the current block. + + +##### spend +``` +Chain.spend(to : address, amount : int) : unit +``` + +Spend `amount` tokens to `to`. Will fail (and abort the contract) if contract +doesn't have `amount` tokens to transfer, or, if `to` is not `payable`. + + +##### timestamp +``` +Chain.timestamp : int +``` + +The timestamp of the current block (unix time, milliseconds). ### Char @@ -914,88 +1002,21 @@ It returns `true` iff the oracle query exist and has the expected type. These need to be explicitly included (with `.aes` suffix) -### Bitwise +### AENSCompat -Bitwise operations on arbitrary precision integers. - -#### bsr +#### pointee\_to\_V2 ``` -Bitwise.bsr(n : int, x : int) : int +AENSCompat.pointee_to_V2(p : AENS.pointee) : AENSv2.pointee ``` -Logical bit shift `x` right `n` positions. +Translate old pointee format to new, this is always possible. - -#### bsl +#### pointee\_from\_V2 ``` -Bitwise.bsl(n : int, x : int) : int +AENSCompat.pointee_from_V2(p2 : AENSv2.pointee) : option(AENS.pointee) ``` -Logical bit shift `x` left `n` positions. - - -#### bsli -``` -Bitwise.bsli(n : int, x : int, lim : int) : int -``` - -Logical bit shift `x` left `n` positions, limit to `lim` bits. - - -#### band -``` -Bitwise.band(x : int, y : int) : int -``` - -Bitwise `and` of `x` and `y`. - - -#### bor -``` -Bitwise.bor(x : int, y : int) : int -``` - -Bitwise `or` of `x` and `y`. - - -#### bxor -``` -Bitwise.bxor(x : int, y : int) : int -``` - -Bitwise `xor` of `x` and `y`. - - -#### bnot -``` -Bitwise.bnot(x : int) : int -``` - -Bitwise `not` of `x`. Defined and implemented as `bnot(x) = bxor(x, -1)`. - - -#### uband -``` -Bitwise.uband(x : int, y : int) : int -``` - -Bitwise `and` of _non-negative_ numbers `x` and `y`. - - -#### ubor -``` -Bitwise.ubor(x : int, y : int) : int -``` - -Bitwise `or` of _non-negative_ `x` and `y`. - - -#### ubxor -``` -Bitwise.ubxor(x : int, y : int) : int -``` - -Bitwise `xor` of _non-negative_ `x` and `y`. +Translate new pointee format to old, `DataPt` can't be translated, so `None` is returned in this case. ### BLS12\_381 diff --git a/docs/sophia_syntax.md b/docs/sophia_syntax.md index abae005..712c9ce 100644 --- a/docs/sophia_syntax.md +++ b/docs/sophia_syntax.md @@ -104,6 +104,7 @@ 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 @@ -238,6 +239,7 @@ Expr ::= '(' LamArgs ')' '=>' Block(Stmt) // Anonymous function (x) => x + | Int | Bytes | String | Char // Literals 123, 0xff, #00abc123, "foo", '%' | AccountAddress | ContractAddress // Chain identifiers | OracleAddress | OracleQueryId // Chain identifiers + | '???' // Hole expression 1 + ??? Generator ::= Pattern '<-' Expr // Generator | 'if' '(' Expr ')' // Guard @@ -254,8 +256,8 @@ Path ::= Id // Record field BinOp ::= '||' | '&&' | '<' | '>' | '=<' | '>=' | '==' | '!=' | '::' | '++' | '+' | '-' | '*' | '/' | 'mod' | '^' - | '|>' -UnOp ::= '-' | '!' + | 'band' | 'bor' | 'bxor' | '<<' | '>>' | '|>' +UnOp ::= '-' | '!' | 'bnot' ``` ## Operators types @@ -264,6 +266,7 @@ UnOp ::= '-' | '!' | --- | --- | `-` `+` `*` `/` `mod` `^` | arithmetic operators | `!` `&&` `||` | logical operators +| `band` `bor` `bxor` `bnot` `<<` `>>` | bitwise operators | `==` `!=` `<` `>` `=<` `>=` | comparison operators | `::` `++` | list operators | `|>` | functional operators @@ -274,13 +277,17 @@ In order of highest to lowest precedence. | Operators | Associativity | --- | --- -| `!` | right +| `!` `bnot`| right | `^` | left | `*` `/` `mod` | left | `-` (unary) | right | `+` `-` | left +| `<<` `>>` | left | `::` `++` | right | `<` `>` `=<` `>=` `==` `!=` | none +| `band` | left +| `bxor` | left +| `bor` | left | `&&` | right | `||` | right | `|>` | left diff --git a/priv/stdlib/AENSCompat.aes b/priv/stdlib/AENSCompat.aes new file mode 100644 index 0000000..baaa05a --- /dev/null +++ b/priv/stdlib/AENSCompat.aes @@ -0,0 +1,17 @@ +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 diff --git a/priv/stdlib/Bitwise.aes b/priv/stdlib/Bitwise.aes deleted file mode 100644 index cc273f0..0000000 --- a/priv/stdlib/Bitwise.aes +++ /dev/null @@ -1,126 +0,0 @@ -@compiler >= 4.3 - -namespace Bitwise = - - // bit shift 'x' right 'n' postions - function bsr(n : int, x : int) : int = - let step = 2^n - let res = x / step - if (x >= 0 || x mod step == 0) - res - else - res - 1 - - // bit shift 'x' left 'n' positions - function bsl(n : int, x : int) : int = - x * 2^n - - // bit shift 'x' left 'n' positions, limit at 'lim' bits - function bsli(n : int, x : int, lim : int) : int = - (x * 2^n) mod (2^lim) - - // bitwise 'and' for arbitrary precision integers - function band(a : int, b : int) : int = - if (a >= 0 && b >= 0) - uband_(a, b) - elif (b >= 0) - ubnand_(b, -1 - a) - elif (a >= 0) - ubnand_(a, -1 - b) - else - -1 - ubor_(-1 - a, -1 - b) - - // bitwise 'or' for arbitrary precision integers - function - bor : (int, int) => int - bor(0, b) = b - bor(a, 0) = a - bor(a : int, b : int) : int = - if (a >= 0 && b >= 0) - ubor_(a, b) - elif (b >= 0) - -1 - ubnand_(-1 - a, b) - elif (a >= 0) - -1 - ubnand_(-1 - b, a) - else - -1 - uband_(-1 - a, -1 - b) - - // bitwise 'xor' for arbitrary precision integers - function - bxor : (int, int) => int - bxor(0, b) = b - bxor(a, 0) = a - bxor(a, b) = - if (a >= 0 && b >= 0) - ubxor_(a, b) - elif (b >= 0) - -1 - ubxor_(-1 - a, b) - elif (a >= 0) - -1 - ubxor_(a, -1 - b) - else - ubxor_(-1 - a, -1 - b) - - // bitwise 'not' for arbitrary precision integers - function bnot(a : int) = bxor(a, -1) - - // Bitwise 'and' for non-negative integers - function uband(a : int, b : int) : int = - require(a >= 0 && b >= 0, "uband is only defined for non-negative integers") - switch((a, b)) - (0, _) => 0 - (_, 0) => 0 - _ => uband__(a, b, 1, 0) - - private function uband_(a, b) = uband__(a, b, 1, 0) - - private function - uband__(0, b, val, acc) = acc - uband__(a, 0, val, acc) = acc - uband__(a, b, val, acc) = - switch (a mod 2 + b mod 2) - 2 => uband__(a / 2, b / 2, val * 2, acc + val) - _ => uband__(a / 2, b / 2, val * 2, acc) - - // Bitwise 'or' for non-negative integers - function ubor(a, b) = - require(a >= 0 && b >= 0, "ubor is only defined for non-negative integers") - switch((a, b)) - (0, _) => b - (_, 0) => a - _ => ubor__(a, b, 1, 0) - - private function ubor_(a, b) = ubor__(a, b, 1, 0) - - private function - ubor__(0, 0, val, acc) = acc - ubor__(a, b, val, acc) = - switch (a mod 2 + b mod 2) - 0 => ubor__(a / 2, b / 2, val * 2, acc) - _ => ubor__(a / 2, b / 2, val * 2, acc + val) - - //Bitwise 'xor' for non-negative integers - function - ubxor : (int, int) => int - ubxor(0, b) = b - ubxor(a, 0) = a - ubxor(a, b) = - require(a >= 0 && b >= 0, "ubxor is only defined for non-negative integers") - ubxor__(a, b, 1, 0) - - private function ubxor_(a, b) = ubxor__(a, b, 1, 0) - - private function - ubxor__(0, 0, val, acc) = acc - ubxor__(a, b, val, acc) = - switch(a mod 2 + b mod 2) - 1 => ubxor__(a / 2, b / 2, val * 2, acc + val) - _ => ubxor__(a / 2, b / 2, val * 2, acc) - - private function ubnand_(a, b) = ubnand__(a, b, 1, 0) - - private function - ubnand__(0, b, val, acc) = acc - ubnand__(a, b, val, acc) = - switch((a mod 2, b mod 2)) - (1, 0) => ubnand__(a / 2, b / 2, val * 2, acc + val) - _ => ubnand__(a / 2, b / 2, val * 2, acc) diff --git a/rebar.config b/rebar.config index ef5bd8e..c19c2fd 100644 --- a/rebar.config +++ b/rebar.config @@ -2,8 +2,7 @@ {erl_opts, [debug_info]}. -{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.2.0"}}} - , {getopt, "1.0.1"} +{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.3.0"}}} , {eblake2, "1.0.0"} , {jsx, {git, "https://github.com/talentdeficit/jsx.git", {tag, "2.8.0"}}} ]}. @@ -14,7 +13,7 @@ {base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]} ]}. -{relx, [{release, {aesophia, "7.0.1"}, +{relx, [{release, {aesophia, "8.0.0"}, [aesophia, aebytecode, getopt]}, {dev_mode, true}, diff --git a/rebar.lock b/rebar.lock index 85a9709..7f13b93 100644 --- a/rebar.lock +++ b/rebar.lock @@ -1,11 +1,11 @@ {"1.2.0", [{<<"aebytecode">>, {git,"https://github.com/aeternity/aebytecode.git", - {ref,"2a0a397afad6b45da52572170f718194018bf33c"}}, + {ref,"b38349274fc2bed98d7fe86877e6e1a2df302109"}}, 0}, {<<"aeserialization">>, {git,"https://github.com/aeternity/aeserialization.git", - {ref,"eb68fe331bd476910394966b7f5ede7a74d37e35"}}, + {ref,"177bf604b2a05e940f92cf00e96e6e269e708245"}}, 1}, {<<"base58">>, {git,"https://github.com/aeternity/erl-base58.git", @@ -16,7 +16,7 @@ {git,"https://github.com/aeternity/enacl.git", {ref,"793ddb502f7fe081302e1c42227dca70b09f8e17"}}, 2}, - {<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0}, + {<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},1}, {<<"jsx">>, {git,"https://github.com/talentdeficit/jsx.git", {ref,"3074d4865b3385a050badf7828ad31490d860df5"}}, diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 4a8c8cb..dd50909 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -124,15 +124,18 @@ -type variance() :: invariant | covariant | contravariant | bivariant. --type fun_info() :: {aeso_syntax:ann(), typesig() | type()}. --type type_info() :: {aeso_syntax:ann(), typedef()}. --type var_info() :: {aeso_syntax:ann(), utype()}. +-type fun_info() :: {aeso_syntax:ann(), typesig() | type()}. +-type type_info() :: {aeso_syntax:ann(), typedef()}. +-type const_info() :: {aeso_syntax:ann(), type()}. +-type var_info() :: {aeso_syntax:ann(), utype()}. --type fun_env() :: [{name(), fun_info()}]. --type type_env() :: [{name(), type_info()}]. +-type fun_env() :: [{name(), fun_info()}]. +-type type_env() :: [{name(), type_info()}]. +-type const_env() :: [{name(), const_info()}]. -record(scope, { funs = [] :: fun_env() , types = [] :: type_env() + , consts = [] :: const_env() , access = public :: access() , kind = namespace :: namespace | contract , ann = [{origin, system}] :: aeso_syntax:ann() @@ -152,6 +155,7 @@ , in_guard = false :: boolean() , stateful = false :: boolean() , unify_throws = true :: boolean() + , current_const = none :: none | aeso_syntax:id() , current_function = none :: none | aeso_syntax:id() , what = top :: top | namespace | contract | contract_interface }). @@ -183,9 +187,13 @@ pop_scope(Env) -> get_scope(#env{ scopes = Scopes }, Name) -> maps:get(Name, Scopes, false). +-spec get_current_scope(env()) -> scope(). +get_current_scope(#env{ namespace = NS, scopes = Scopes }) -> + maps:get(NS, Scopes). + -spec on_current_scope(env(), fun((scope()) -> scope())) -> env(). on_current_scope(Env = #env{ namespace = NS, scopes = Scopes }, Fun) -> - Scope = maps:get(NS, Scopes), + Scope = get_current_scope(Env), Env#env{ scopes = Scopes#{ NS => Fun(Scope) } }. -spec on_scopes(env(), fun((scope()) -> scope())) -> env(). @@ -193,8 +201,8 @@ on_scopes(Env = #env{ scopes = Scopes }, Fun) -> Env#env{ scopes = maps:map(fun(_, Scope) -> Fun(Scope) end, Scopes) }. -spec bind_var(aeso_syntax:id(), utype(), env()) -> env(). -bind_var({id, Ann, X}, T, Env = #env{ vars = Vars }) -> - when_warning(warn_shadowing, fun() -> warn_potential_shadowing(Ann, X, Vars) end), +bind_var({id, Ann, X}, T, Env) -> + when_warning(warn_shadowing, fun() -> warn_potential_shadowing(Env, Ann, X) end), Env#env{ vars = [{X, {Ann, T}} | Env#env.vars] }. -spec bind_vars([{aeso_syntax:id(), utype()}], env()) -> env(). @@ -229,7 +237,7 @@ force_bind_fun(X, Type, Env = #env{ what = What }) -> NoCode = get_option(no_code, false), Entry = if X == "init", What == contract, not NoCode -> {reserved_init, Ann, Type}; - What == contract_interface -> {contract_fun, Ann, Type}; + What == contract; What == contract_interface -> {contract_fun, Ann, Type}; true -> {Ann, Type} end, on_current_scope(Env, fun(Scope = #scope{ funs = Funs }) -> @@ -247,6 +255,37 @@ bind_type(X, Ann, Def, Env) -> Scope#scope{ types = [{X, {Ann, Def}} | Types] } end). +-spec bind_const(name(), aeso_syntax:ann(), type(), env()) -> env(). +bind_const(X, Ann, Type, Env) -> + case lookup_env(Env, term, Ann, [X]) of + false -> + on_current_scope(Env, fun(Scope = #scope{ consts = Consts }) -> + Scope#scope{ consts = [{X, {Ann, Type}} | Consts] } + end); + _ -> + type_error({duplicate_definition, X, [Ann, aeso_syntax:get_ann(Type)]}), + Env + end. + +-spec bind_consts(env(), #{ name() => aeso_syntax:decl() }, [{acyclic, name()} | {cyclic, [name()]}], [aeso_syntax:decl()]) -> + {env(), [aeso_syntax:decl()]}. +bind_consts(Env, _Consts, [], Acc) -> + {Env, lists:reverse(Acc)}; +bind_consts(Env, Consts, [{cyclic, Xs} | _SCCs], _Acc) -> + ConstDecls = [ maps:get(X, Consts) || X <- Xs ], + type_error({mutually_recursive_constants, lists:reverse(ConstDecls)}), + {Env, []}; +bind_consts(Env, Consts, [{acyclic, X} | SCCs], Acc) -> + case maps:get(X, Consts, undefined) of + Const = {letval, Ann, Id, _} -> + NewConst = {letval, _, {typed, _, _, Type}, _} = infer_const(Env, Const), + NewEnv = bind_const(name(Id), Ann, Type, Env), + bind_consts(NewEnv, Consts, SCCs, [NewConst | Acc]); + undefined -> + %% When a used id is not a letval, a type error will be thrown + bind_consts(Env, Consts, SCCs, Acc) + end. + %% Bind state primitives -spec bind_state(env()) -> env(). bind_state(Env) -> @@ -312,11 +351,11 @@ bind_contract(Typing, {Contract, Ann, Id, _Impls, Contents}, Env) Sys = [{origin, system}], TypeOrFresh = fun({typed, _, _, Type}) -> Type; (_) -> fresh_uvar(Sys) end, Fields = - [ {field_t, AnnF, Entrypoint, contract_call_type(Type)} + [ {field_t, AnnF, Entrypoint, contract_call_type(aeso_syntax:set_ann(Sys, Type))} || {fun_decl, AnnF, Entrypoint, Type = {fun_t, _, _, _, _}} <- Contents ] ++ [ {field_t, AnnF, Entrypoint, contract_call_type( - {fun_t, AnnF, [], [TypeOrFresh(Arg) || Arg <- Args], TypeOrFresh(Ret)}) + {fun_t, Sys, [], [TypeOrFresh(Arg) || Arg <- Args], TypeOrFresh(Ret)}) } || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, [{guarded, _, [], Ret}]} <- Contents, Name =/= "init" @@ -426,23 +465,35 @@ lookup_env(Env, Kind, Ann, Name) -> lookup_env1(#env{ namespace = Current, used_namespaces = UsedNamespaces, scopes = Scopes }, Kind, Ann, QName) -> Qual = lists:droplast(QName), Name = lists:last(QName), + QNameIsEvent = lists:suffix(["Chain", "event"], QName), AllowPrivate = lists:prefix(Qual, Current), %% Get the scope case maps:get(Qual, Scopes, false) of false -> false; %% TODO: return reason for not in scope - #scope{ funs = Funs, types = Types } -> + #scope{ funs = Funs, types = Types, consts = Consts, kind = ScopeKind } -> Defs = case Kind of type -> Types; term -> Funs end, %% Look up the unqualified name case proplists:get_value(Name, Defs, false) of - false -> false; + false -> + case proplists:get_value(Name, Consts, false) of + false -> + false; + Const when AllowPrivate; ScopeKind == namespace -> + {QName, Const}; + Const -> + type_error({contract_treated_as_namespace_constant, Ann, QName}), + {QName, Const} + end; {reserved_init, Ann1, Type} -> type_error({cannot_call_init_function, Ann}), {QName, {Ann1, Type}}; %% Return the type to avoid an extra not-in-scope error + {contract_fun, Ann1, Type} when AllowPrivate orelse QNameIsEvent -> + {QName, {Ann1, Type}}; {contract_fun, Ann1, Type} -> - type_error({contract_treated_as_namespace, Ann, QName}), + type_error({contract_treated_as_namespace_entrypoint, Ann, QName}), {QName, {Ann1, Type}}; {Ann1, _} = E -> %% Check that it's not private (or we can see private funs) @@ -483,8 +534,11 @@ qname({qid, _, Xs}) -> Xs; qname({con, _, X}) -> [X]; qname({qcon, _, Xs}) -> Xs. --spec name(aeso_syntax:id() | aeso_syntax:con()) -> name(). -name({_, _, X}) -> X. +-spec name(Named | {typed, _, Named, _}) -> name() when + Named :: aeso_syntax:id() | aeso_syntax:con(). +name({typed, _, X, _}) -> name(X); +name({id, _, X}) -> X; +name({con, _, X}) -> X. -spec qid(aeso_syntax:ann(), qname()) -> aeso_syntax:id() | aeso_syntax:qid(). qid(Ann, [X]) -> {id, Ann, X}; @@ -540,6 +594,8 @@ global_env() -> TTL = {qid, Ann, ["Chain", "ttl"]}, Pointee = {qid, Ann, ["AENS", "pointee"]}, AENSName = {qid, Ann, ["AENS", "name"]}, + PointeeV2 = {qid, Ann, ["AENSv2", "pointee"]}, + AENSNameV2 = {qid, Ann, ["AENSv2", "name"]}, Fr = {qid, Ann, ["MCL_BLS12_381", "fr"]}, Fp = {qid, Ann, ["MCL_BLS12_381", "fp"]}, Fp2 = {tuple_t, Ann, [Fp, Fp]}, @@ -675,14 +731,7 @@ global_env() -> AENSScope = #scope { funs = MkDefs( - [{"resolve", Fun([String, String], option_t(Ann, A))}, - {"preclaim", SignFun([Address, Hash], Unit)}, - {"claim", SignFun([Address, String, Int, Int], Unit)}, - {"transfer", SignFun([Address, Address, String], Unit)}, - {"revoke", SignFun([Address, String], Unit)}, - {"update", SignFun([Address, String, Option(TTL), Option(Int), Option(Map(String, Pointee))], Unit)}, - {"lookup", Fun([String], option_t(Ann, AENSName))}, - %% AENS pointee constructors + [%% AENS pointee constructors {"AccountPt", Fun1(Address, Pointee)}, {"OraclePt", Fun1(Address, Pointee)}, {"ContractPt", Fun1(Address, Pointee)}, @@ -692,6 +741,26 @@ global_env() -> ]) , types = MkDefs([{"pointee", 0}, {"name", 0}]) }, + AENSv2Scope = #scope + { funs = MkDefs( + [{"resolve", Fun([String, String], option_t(Ann, A))}, + {"preclaim", SignFun([Address, Hash], Unit)}, + {"claim", SignFun([Address, String, Int, Int], Unit)}, + {"transfer", SignFun([Address, Address, String], Unit)}, + {"revoke", SignFun([Address, String], Unit)}, + {"update", SignFun([Address, String, Option(TTL), Option(Int), Option(Map(String, PointeeV2))], Unit)}, + {"lookup", Fun([String], option_t(Ann, AENSNameV2))}, + %% AENS pointee constructors v2 + {"AccountPt", Fun1(Address, PointeeV2)}, + {"OraclePt", Fun1(Address, PointeeV2)}, + {"ContractPt", Fun1(Address, PointeeV2)}, + {"ChannelPt", Fun1(Address, PointeeV2)}, + {"DataPt", Fun1(String, PointeeV2)}, + %% Name object constructor v2 + {"Name", Fun([Address, TTL, Map(String, PointeeV2)], AENSNameV2)} + ]) + , types = MkDefs([{"pointee", 0}, {"name", 0}]) }, + MapScope = #scope { funs = MkDefs( [{"from_list", Fun1(List(Pair(K, V)), Map(K, V))}, @@ -711,7 +780,8 @@ global_env() -> {"ecrecover_secp256k1", Fun([Hash, Bytes(65)], Option(Bytes(20)))}, {"sha3", Fun1(A, Hash)}, {"sha256", Fun1(A, Hash)}, - {"blake2b", Fun1(A, Hash)}]) }, + {"blake2b", Fun1(A, Hash)}, + {"poseidon", Fun([Int, Int], Int)}]) }, %% Fancy BLS12-381 crypto operations MCL_BLS12_381_Scope = #scope @@ -796,14 +866,16 @@ global_env() -> ]) }, %% Conversion - IntScope = #scope{ funs = MkDefs([{"to_str", Fun1(Int, String)}]) }, + IntScope = #scope{ funs = MkDefs([{"to_str", Fun1(Int, String)}, + {"mulmod", Fun([Int, Int, Int], Int)}]) }, + AddressScope = #scope{ funs = MkDefs([{"to_str", Fun1(Address, String)}, + {"to_bytes", Fun1(Address, Bytes(32))}, {"to_contract", FunC(address_to_contract, [Address], A)}, {"is_oracle", Fun1(Address, Bool)}, {"is_contract", Fun1(Address, Bool)}, {"is_payable", Fun1(Address, Bool)}]) }, - #env{ scopes = #{ [] => TopScope , ["Chain"] => ChainScope @@ -811,6 +883,7 @@ global_env() -> , ["Call"] => CallScope , ["Oracle"] => OracleScope , ["AENS"] => AENSScope + , ["AENSv2"] => AENSv2Scope , ["Map"] => MapScope , ["Auth"] => AuthScope , ["Crypto"] => CryptoScope @@ -906,6 +979,7 @@ infer1(Env0, [Contract0 = {Contract, Ann, ConName, Impls, Code} | Rest], Acc, Op contract -> ets_insert(defined_contracts, {qname(ConName)}); contract_interface -> ok end, + check_contract_preserved_payability(Env, ConName, Ann, Impls, Acc, What), populate_functions_to_implement(Env, ConName, Impls, Acc), Env1 = bind_contract(untyped, Contract0, Env), {Env2, Code1} = infer_contract_top(push_scope(contract, ConName, Env1), What, Code, Options), @@ -931,6 +1005,25 @@ infer1(Env, [{pragma, _, _} | Rest], Acc, Options) -> %% Pragmas are checked in check_modifiers infer1(Env, Rest, Acc, Options). +-spec check_contract_preserved_payability(env(), Con, Ann, Impls, Contracts, Kind) -> ok | no_return() when + Con :: aeso_syntax:con(), + Ann :: aeso_syntax:ann(), + Impls :: [Con], + Contracts :: [aeso_syntax:decl()], + Kind :: contract | contract_interface. +check_contract_preserved_payability(Env, ContractName, ContractAnn, Impls, DefinedContracts, Kind) -> + Payable = proplists:get_value(payable, ContractAnn, false), + ImplsNames = [ name(I) || I <- Impls ], + Interfaces = [ Con || I = {contract_interface, _, Con, _, _} <- DefinedContracts, + lists:member(name(Con), ImplsNames), + aeso_syntax:get_ann(payable, I, false) ], + + create_type_errors(), + [ type_error({unpreserved_payablity, Kind, ContractName, I}) || I <- Interfaces, Payable == false ], + destroy_and_report_type_errors(Env), + + ok. + %% Report all functions that were not implemented by the contract ContractName. -spec report_unimplemented_functions(env(), ContractName) -> ok | no_return() when ContractName :: aeso_syntax:con(). @@ -1031,6 +1124,7 @@ infer_contract(Env0, What, Defs0, Options) -> ({fun_clauses, _, _, _, _}) -> function; ({fun_decl, _, _, _}) -> prototype; ({using, _, _, _, _}) -> using; + ({letval, _, _, _}) -> constant; (_) -> unexpected end, Get = fun(K, In) -> [ Def || Def <- In, Kind(Def) == K ] end, @@ -1046,11 +1140,12 @@ infer_contract(Env0, What, Defs0, Options) -> contract_interface -> Env1; contract -> bind_state(Env1) %% bind state and put end, - {ProtoSigs, Decls} = lists:unzip([ check_fundecl(Env1, Decl) || Decl <- Get(prototype, Defs) ]), + {Env2C, Consts} = check_constants(Env2, Get(constant, Defs)), + {ProtoSigs, Decls} = lists:unzip([ check_fundecl(Env2C, Decl) || Decl <- Get(prototype, Defs) ]), [ type_error({missing_definition, Id}) || {fun_decl, _, Id, _} <- Decls, What =:= contract, get_option(no_code, false) =:= false ], - Env3 = bind_funs(ProtoSigs, Env2), + Env3 = bind_funs(ProtoSigs, Env2C), Functions = Get(function, Defs), %% Check for duplicates in Functions (we turn it into a map below) FunBind = fun({letfun, Ann, {id, _, Fun}, _, _, _}) -> {Fun, {tuple_t, Ann, []}}; @@ -1070,7 +1165,7 @@ infer_contract(Env0, What, Defs0, Options) -> check_entrypoints(Defs1), destroy_and_report_type_errors(Env4), %% Add inferred types of definitions - {Env5, TypeDefs ++ Decls ++ Defs1}. + {Env5, TypeDefs ++ Decls ++ Consts ++ Defs1}. %% Restructure blocks into multi-clause fundefs (`fun_clauses`). -spec process_blocks([aeso_syntax:decl()]) -> [aeso_syntax:decl()]. @@ -1220,6 +1315,21 @@ opposite_variance(covariant) -> contravariant; opposite_variance(contravariant) -> covariant; opposite_variance(bivariant) -> bivariant. +-spec check_constants(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. +check_constants(Env = #env{ what = What }, Consts) -> + HasValidId = fun({letval, _, {id, _, _}, _}) -> true; + ({letval, _, {typed, _, {id, _, _}, _}, _}) -> true; + (_) -> false + end, + {Valid, Invalid} = lists:partition(HasValidId, Consts), + [ type_error({invalid_const_id, aeso_syntax:get_ann(Pat)}) || {letval, _, Pat, _} <- Invalid ], + [ type_error({illegal_const_in_interface, Ann}) || {letval, Ann, _, _} <- Valid, What == contract_interface ], + when_warning(warn_unused_constants, fun() -> potential_unused_constants(Env, Valid) end), + ConstMap = maps:from_list([ {name(Id), Const} || Const = {letval, _, Id, _} <- Valid ]), + DepGraph = maps:map(fun(_, Const) -> aeso_syntax_utils:used_ids(Const) end, ConstMap), + SCCs = aeso_utils:scc(DepGraph), + bind_consts(Env, ConstMap, SCCs, []). + check_usings(Env, []) -> Env; check_usings(Env = #env{ used_namespaces = UsedNamespaces }, [{using, Ann, Con, Alias, Parts} | Rest]) -> @@ -1234,6 +1344,10 @@ check_usings(Env = #env{ used_namespaces = UsedNamespaces }, [{using, Ann, Con, create_type_errors(), type_error({using_undefined_namespace, Ann, qname(Con)}), destroy_and_report_type_errors(Env); + #scope{kind = contract} -> + create_type_errors(), + type_error({using_undefined_namespace, Ann, qname(Con)}), + destroy_and_report_type_errors(Env); Scope -> Nsp = case Parts of none -> @@ -1487,19 +1601,37 @@ check_reserved_entrypoints(Funs) -> check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type = {fun_t, _, _, _, _}}) -> Type1 = {fun_t, _, Named, Args, Ret} = check_type(Env, Type), TypeSig = {type_sig, Ann, none, Named, Args, Ret}, - register_implementation(Name), + register_implementation(Id, TypeSig), {{Name, TypeSig}, {fun_decl, Ann, Id, Type1}}; check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) -> type_error({fundecl_must_have_funtype, Ann, Id, Type}), {{Name, {type_sig, Ann, none, [], [], Type}}, check_type(Env, Type)}. -%% Register the function FunName as implemented by deleting it from the functions +%% Register the function FunId as implemented by deleting it from the functions %% to be implemented table if it is included there, or return true otherwise. --spec register_implementation(FunName) -> true | no_return() when - FunName :: string(). -register_implementation(Name) -> +-spec register_implementation(FunId, FunSig) -> true | no_return() when + FunId :: aeso_syntax:id(), + FunSig :: typesig(). +register_implementation(Id, Sig) -> + Name = name(Id), case ets_lookup(functions_to_implement, Name) of - [{Name, _, {fun_decl, _, _, _}}] -> + [{Name, Interface, Decl = {fun_decl, _, DeclId, _}}] -> + DeclStateful = aeso_syntax:get_ann(stateful, Decl, false), + DeclPayable = aeso_syntax:get_ann(payable, Decl, false), + + SigEntrypoint = aeso_syntax:get_ann(entrypoint, Sig, false), + SigStateful = aeso_syntax:get_ann(stateful, Sig, false), + SigPayable = aeso_syntax:get_ann(payable, Sig, false), + + [ type_error({function_should_be_entrypoint, Id, DeclId, Interface}) + || not SigEntrypoint ], + + [ type_error({entrypoint_cannot_be_stateful, Id, DeclId, Interface}) + || SigStateful andalso not DeclStateful ], + + [ type_error({entrypoint_must_be_payable, Id, DeclId, Interface}) + || not SigPayable andalso DeclPayable ], + ets_delete(functions_to_implement, Name); [] -> true; @@ -1509,9 +1641,9 @@ register_implementation(Name) -> infer_nonrec(Env, LetFun) -> create_constraints(), - NewLetFun = {{FunName, _}, _} = infer_letfun(Env, LetFun), + NewLetFun = {{_, Sig}, _} = infer_letfun(Env, LetFun), check_special_funs(Env, NewLetFun), - register_implementation(FunName), + register_implementation(get_letfun_id(LetFun), Sig), solve_then_destroy_and_report_unsolved_constraints(Env), Result = {TypeSig, _} = instantiate(NewLetFun), print_typesig(TypeSig), @@ -1540,8 +1672,8 @@ infer_letrec(Env, Defs) -> ExtendEnv = bind_funs(Funs, Env), Inferred = [ begin - Res = {{Name, TypeSig}, _} = infer_letfun(ExtendEnv, LF), - register_implementation(Name), + Res = {{Name, TypeSig}, LetFun} = infer_letfun(ExtendEnv, LF), + register_implementation(get_letfun_id(LetFun), TypeSig), Got = proplists:get_value(Name, Funs), Expect = typesig_to_fun_t(TypeSig), unify(Env, Got, Expect, {check_typesig, Name, Got, Expect}), @@ -1593,6 +1725,9 @@ infer_letfun1(Env0 = #env{ namespace = NS }, {letfun, Attrib, Fun = {id, NameAtt {{Name, TypeSig}, {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewGuardedBodies}}. +get_letfun_id({fun_clauses, _, Id, _, _}) -> Id; +get_letfun_id({letfun, _, Id, _, _, _}) -> Id. + desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) -> NeedDesugar = case Clauses of @@ -1639,9 +1774,19 @@ lookup_name(Env = #env{ namespace = NS, current_function = CurFn }, As, Id, Opti type_error({unbound_variable, Id}), {Id, fresh_uvar(As)}; {QId, {_, Ty}} -> - when_warning(warn_unused_variables, fun() -> used_variable(NS, name(CurFn), QId) end), - when_warning(warn_unused_functions, - fun() -> register_function_call(NS ++ qname(CurFn), QId) end), + %% Variables and functions cannot be used when CurFn is `none`. + %% i.e. they cannot be used in toplevel constants + [ begin + when_warning( + warn_unused_variables, + fun() -> used_variable(NS, name(CurFn), QId) end), + when_warning( + warn_unused_functions, + fun() -> register_function_call(NS ++ qname(CurFn), QId) end) + end || CurFn =/= none ], + + when_warning(warn_unused_constants, fun() -> used_constant(NS, QId) end), + Freshen = proplists:get_value(freshen, Options, false), check_stateful(Env, Id, Ty), Ty1 = case Ty of @@ -1670,10 +1815,14 @@ check_stateful(#env { current_function = Fun }, _Id, _Type) -> %% Hack: don't allow passing the 'value' named arg if not stateful. This only %% works since the user can't create functions with named arguments. -check_stateful_named_arg(#env{ stateful = false, current_function = Fun }, {id, _, "value"}, Default) -> +check_stateful_named_arg(#env{ stateful = Stateful, current_function = Fun }, {id, _, "value"}, Default) -> case Default of {int, _, 0} -> ok; - _ -> type_error({value_arg_not_allowed, Default, Fun}) + _ -> + case Stateful of + true -> when_warning(warn_unused_stateful, fun() -> used_stateful(Fun) end); + false -> type_error({value_arg_not_allowed, Default, Fun}) + end end; check_stateful_named_arg(_, _, _) -> ok. @@ -1791,6 +1940,10 @@ infer_expr(_Env, Body={contract_pubkey, As, _}) -> {typed, As, Body, Con}; infer_expr(_Env, Body={id, As, "_"}) -> {typed, As, Body, fresh_uvar(As)}; +infer_expr(_Env, Body={id, As, "???"}) -> + T = fresh_uvar(As), + type_error({hole_found, As, T}), + {typed, As, Body, T}; infer_expr(Env, Id = {Tag, As, _}) when Tag == id; Tag == qid -> {QName, Type} = lookup_name(Env, As, Id), {typed, As, QName, Type}; @@ -1880,7 +2033,7 @@ infer_expr(Env, {app, Ann, Fun, Args0} = App) -> unify(Env, FunType, {fun_t, [], NamedArgsVar, ArgTypes, GeneralResultType}, When), when_warning(warn_negative_spend, fun() -> warn_potential_negative_spend(Ann, NewFun1, NewArgs) end), [ add_constraint({aens_resolve_type, GeneralResultType}) - || element(3, FunName) =:= ["AENS", "resolve"] ], + || element(3, FunName) =:= ["AENSv2", "resolve"] ], [ add_constraint({oracle_type, Ann, OType}) || OType <- [get_oracle_type(FunName, ArgTypes, GeneralResultType)], OType =/= false ], @@ -1998,6 +2151,81 @@ infer_expr(Env, Let = {letfun, Attrs, _, _, _, _}) -> type_error({missing_body_for_let, Attrs}), infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]}). +check_valid_const_expr({bool, _, _}) -> + true; +check_valid_const_expr({int, _, _}) -> + true; +check_valid_const_expr({char, _, _}) -> + true; +check_valid_const_expr({string, _, _}) -> + true; +check_valid_const_expr({bytes, _, _}) -> + true; +check_valid_const_expr({account_pubkey, _, _}) -> + true; +check_valid_const_expr({oracle_pubkey, _, _}) -> + true; +check_valid_const_expr({oracle_query_id, _, _}) -> + true; +check_valid_const_expr({contract_pubkey, _, _}) -> + true; +check_valid_const_expr({id, _, "_"}) -> + true; +check_valid_const_expr({Tag, _, _}) when Tag == id; Tag == qid; Tag == con; Tag == qcon -> + true; +check_valid_const_expr({tuple, _, Cpts}) -> + lists:all(fun(X) -> X end, [ check_valid_const_expr(C) || C <- Cpts ]); +check_valid_const_expr({list, _, Elems}) -> + lists:all(fun(X) -> X end, [ check_valid_const_expr(Elem) || Elem <- Elems ]); +check_valid_const_expr({list_comp, _, _, _}) -> + false; +check_valid_const_expr({typed, _, Body, _}) -> + check_valid_const_expr(Body); +check_valid_const_expr({app, Ann, Fun, Args0}) -> + {_, Args} = split_args(Args0), + case aeso_syntax:get_ann(format, Ann) of + infix -> + lists:all(fun(X) -> X end, [ check_valid_const_expr(Arg) || Arg <- Args ]); + prefix -> + lists:all(fun(X) -> X end, [ check_valid_const_expr(Arg) || Arg <- Args ]); + _ -> + %% Applications of data constructors are allowed in constants + lists:member(element(1, Fun), [con, qcon]) + end; +check_valid_const_expr({'if', _, _, _, _}) -> + false; +check_valid_const_expr({switch, _, _, _}) -> + false; +check_valid_const_expr({record, _, Fields}) -> + lists:all(fun(X) -> X end, [ check_valid_const_expr(Expr) || {field, _, _, Expr} <- Fields ]); +check_valid_const_expr({record, _, _, _}) -> + false; +check_valid_const_expr({proj, _, Record, _}) -> + check_valid_const_expr(Record); +% Maps +check_valid_const_expr({map_get, _, _, _}) -> %% map lookup + false; +check_valid_const_expr({map_get, _, _, _, _}) -> %% map lookup with default + false; +check_valid_const_expr({map, _, KVs}) -> %% map construction + lists:all(fun(X) -> X end, [ check_valid_const_expr(K) andalso check_valid_const_expr(V) || {K, V} <- KVs ]); +check_valid_const_expr({map, _, _, _}) -> %% map update + false; +check_valid_const_expr({block, _, _}) -> + false; +check_valid_const_expr({record_or_map_error, _, Fields}) -> + lists:all(fun(X) -> X end, [ check_valid_const_expr(Expr) || {field, _, _, Expr} <- Fields ]); +check_valid_const_expr({record_or_map_error, _, _, _}) -> + false; +check_valid_const_expr({lam, _, _, _}) -> + false; +check_valid_const_expr({letpat, _, _, _}) -> + false; +check_valid_const_expr({letval, _, _, _}) -> + false; +check_valid_const_expr({letfun, _, _, _, _, _}) -> + false. + infer_var_args_fun(Env, {typed, Ann, Fun, FunType0}, NamedArgs, ArgTypes) -> FunType = case Fun of @@ -2122,9 +2350,14 @@ infer_pattern(Env, Pattern) -> NewPattern = infer_expr(NewEnv, Pattern), {NewEnv#env{ in_pattern = Env#env.in_pattern }, NewPattern}. -infer_case(Env = #env{ namespace = NS, current_function = {id, _, Fun} }, Attrs, Pattern, ExprType, GuardedBranches, SwitchType) -> +infer_case(Env = #env{ namespace = NS, current_function = FunId }, Attrs, Pattern, ExprType, GuardedBranches, SwitchType) -> {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern), - when_warning(warn_unused_variables, fun() -> potential_unused_variables(NS, Fun, free_vars(Pattern)) end), + + %% Make sure we are inside a function before warning about potentially unused var + [ when_warning(warn_unused_variables, + fun() -> potential_unused_variables(NS, Fun, free_vars(Pattern)) end) + || {id, _, Fun} <- [FunId] ], + InferGuardedBranches = fun({guarded, Ann, Guards, Branch}) -> NewGuards = lists:map(fun(Guard) -> check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrs, "bool"}) @@ -2158,6 +2391,19 @@ infer_block(Env, Attrs, [E|Rest], BlockType) -> when_warning(warn_unused_return_value, fun() -> potential_unused_return_value(NewE) end), [NewE|infer_block(Env, Attrs, Rest, BlockType)]. +infer_const(Env, {letval, Ann, TypedId = {typed, _, Id = {id, _, _}, Type}, Expr}) -> + check_valid_const_expr(Expr) orelse type_error({invalid_const_expr, Id}), + NewExpr = check_expr(Env#env{ current_const = Id }, Expr, Type), + {letval, Ann, TypedId, NewExpr}; +infer_const(Env, {letval, Ann, Id = {id, AnnId, _}, Expr}) -> + check_valid_const_expr(Expr) orelse type_error({invalid_const_expr, Id}), + create_constraints(), + NewExpr = {typed, _, _, Type} = infer_expr(Env#env{ current_const = Id }, Expr), + solve_then_destroy_and_report_unsolved_constraints(Env), + IdType = setelement(2, Type, AnnId), + NewId = {typed, aeso_syntax:get_ann(Id), Id, IdType}, + instantiate({letval, Ann, NewId, NewExpr}). + infer_infix({BoolOp, As}) when BoolOp =:= '&&'; BoolOp =:= '||' -> Bool = {id, As, "bool"}, @@ -2167,6 +2413,11 @@ infer_infix({IntOp, As}) IntOp == '^'; IntOp == 'mod' -> Int = {id, As, "int"}, {fun_t, As, [], [Int, Int], Int}; +infer_infix({BitOp, As}) + when BitOp == 'band'; BitOp == 'bor'; BitOp == 'bxor'; + BitOp == '<<'; BitOp == '>>' -> + Int = {id, As, "int"}, + {fun_t, As, [], [Int, Int], Int}; infer_infix({RelOp, As}) when RelOp == '=='; RelOp == '!='; RelOp == '<'; RelOp == '>'; @@ -2194,6 +2445,9 @@ infer_infix({'|>', As}) -> infer_prefix({'!',As}) -> Bool = {id, As, "bool"}, {fun_t, As, [], [Bool], Bool}; +infer_prefix({BitOp,As}) when BitOp =:= 'bnot' -> + Int = {id, As, "int"}, + {fun_t, As, [], [Int], Int}; infer_prefix({IntOp,As}) when IntOp =:= '-' -> Int = {id, As, "int"}, {fun_t, As, [], [Int], Int}. @@ -3121,6 +3375,7 @@ all_warnings() -> [ warn_unused_includes , warn_unused_stateful , warn_unused_variables + , warn_unused_constants , warn_unused_typedefs , warn_unused_return_value , warn_unused_functions @@ -3151,9 +3406,14 @@ when_warning(Warn, Do) -> %% Warnings (Unused includes) potential_unused_include(Ann, SrcFile) -> - case aeso_syntax:get_ann(file, Ann, no_file) of - no_file -> ok; - File -> ets_insert(warnings, {unused_include, File, SrcFile}) + IsIncluded = aeso_syntax:get_ann(include_type, Ann, none) =/= none, + case IsIncluded of + false -> ok; + true -> + case aeso_syntax:get_ann(file, Ann, no_file) of + no_file -> ok; + File -> ets_insert(warnings, {unused_include, File, SrcFile}) + end end. used_include(Ann) -> @@ -3193,6 +3453,17 @@ used_variable(Namespace, Fun, [VarName]) -> ets_match_delete(warnings, {unused_variable, '_', Namespace, Fun, VarName}); used_variable(_, _, _) -> ok. +%% Warnings (Unused constants) + +potential_unused_constants(#env{ what = namespace }, _Consts) -> + []; +potential_unused_constants(#env{ namespace = Namespace }, Consts) -> + [ ets_insert(warnings, {unused_constant, Ann, Namespace, Name}) || {letval, _, {id, Ann, Name}, _} <- Consts ]. + +used_constant(Namespace = [Contract], [Contract, ConstName]) -> + ets_match_delete(warnings, {unused_constant, '_', Namespace, ConstName}); +used_constant(_, _) -> ok. + %% Warnings (Unused return value) potential_unused_return_value({typed, Ann, {app, _, {typed, _, _, {fun_t, _, _, _, {id, _, Type}}}, _}, _}) when Type /= "unit" -> @@ -3238,9 +3509,11 @@ destroy_and_report_unused_functions() -> %% Warnings (Shadowing) -warn_potential_shadowing(_, "_", _) -> ok; -warn_potential_shadowing(Ann, Name, Vars) -> - case proplists:get_value(Name, Vars, false) of +warn_potential_shadowing(_, _, "_") -> ok; +warn_potential_shadowing(Env = #env{ vars = Vars }, Ann, Name) -> + CurrentScope = get_current_scope(Env), + Consts = CurrentScope#scope.consts, + case proplists:get_value(Name, Vars ++ Consts, false) of false -> ok; {AnnOld, _} -> ets_insert(warnings, {shadowing, Ann, Name, AnnOld}) end. @@ -3344,6 +3617,9 @@ mk_error({cannot_unify, A, B, Cxt, When}) -> [pp(instantiate(A)), pp(instantiate(B))]), {Pos, Ctxt} = pp_when(When), mk_t_err(Pos, Msg, Ctxt); +mk_error({hole_found, Ann, Type}) -> + Msg = io_lib:format("Found a hole of type `~s`", [pp(instantiate(Type))]), + mk_t_err(pos(Ann), Msg); mk_error({unbound_variable, Id}) -> Msg = io_lib:format("Unbound variable `~s`", [pp(Id)]), case Id of @@ -3479,10 +3755,6 @@ mk_error({type_decl, _, {id, Pos, Name}, _}) -> Msg = io_lib:format("Empty type declarations are not supported. Type `~s` lacks a definition", [Name]), mk_t_err(pos(Pos), Msg); -mk_error({letval, _Pos, {id, Pos, Name}, _Def}) -> - Msg = io_lib:format("Toplevel \"let\" definitions are not supported. Value `~s` could be replaced by 0-argument function.", - [Name]), - mk_t_err(pos(Pos), Msg); mk_error({stateful_not_allowed, Id, Fun}) -> Msg = io_lib:format("Cannot reference stateful function `~s` in the definition of non-stateful function `~s`.", [pp(Id), pp(Fun)]), @@ -3566,10 +3838,14 @@ mk_error({cannot_call_init_function, Ann}) -> Msg = "The 'init' function is called exclusively by the create contract transaction " "and cannot be called from the contract code.", mk_t_err(pos(Ann), Msg); -mk_error({contract_treated_as_namespace, Ann, [Con, Fun] = QName}) -> +mk_error({contract_treated_as_namespace_entrypoint, Ann, [Con, Fun] = QName}) -> Msg = io_lib:format("Invalid call to contract entrypoint `~s`.", [string:join(QName, ".")]), Cxt = io_lib:format("It must be called as `c.~s` for some `c : ~s`.", [Fun, Con]), mk_t_err(pos(Ann), Msg, Cxt); +mk_error({contract_treated_as_namespace_constant, Ann, QName}) -> + Msg = io_lib:format("Invalid use of the contract constant `~s`.", [string:join(QName, ".")]), + Cxt = "Toplevel contract constants can only be used in the contracts where they are defined.", + mk_t_err(pos(Ann), Msg, Cxt); mk_error({bad_top_level_decl, Decl}) -> What = case element(1, Decl) of letval -> "function or entrypoint"; @@ -3659,7 +3935,7 @@ mk_error({empty_record_definition, Ann, Name}) -> Msg = io_lib:format("Empty record definitions are not allowed. Cannot define the record `~s`", [Name]), mk_t_err(pos(Ann), Msg); mk_error({unimplemented_interface_function, ConId, InterfaceName, FunName}) -> - Msg = io_lib:format("Unimplemented function `~s` from the interface `~s` in the contract `~s`", [FunName, InterfaceName, pp(ConId)]), + Msg = io_lib:format("Unimplemented entrypoint `~s` from the interface `~s` in the contract `~s`", [FunName, InterfaceName, pp(ConId)]), mk_t_err(pos(ConId), Msg); mk_error({referencing_undefined_interface, InterfaceId}) -> Msg = io_lib:format("Trying to implement or extend an undefined interface `~s`", [pp(InterfaceId)]), @@ -3691,7 +3967,7 @@ mk_error({higher_order_entrypoint, Ann, {id, _, Name}, Thing}) -> [ThingS, Name, Bad]), mk_t_err(pos(Ann), Msg); mk_error({invalid_aens_resolve_type, Ann, T}) -> - Msg = io_lib:format("Invalid return type of `AENS.resolve`:\n" + Msg = io_lib:format("Invalid return type of `AENSv2.resolve`:\n" "~s`\n" "It must be a `string` or a pubkey type (`address`, `oracle`, etc)", [pp_type(" `", T)]), @@ -3707,6 +3983,46 @@ mk_error({interface_implementation_conflict, Contract, I1, I2, Fun}) -> "the contract `~s` have a function called `~s`", [name(I1), name(I2), name(Contract), name(Fun)]), mk_t_err(pos(Contract), Msg); +mk_error({function_should_be_entrypoint, Impl, Base, Interface}) -> + Msg = io_lib:format("`~s` must be declared as an entrypoint instead of a function " + "in order to implement the entrypoint `~s` from the interface `~s`", + [name(Impl), name(Base), name(Interface)]), + mk_t_err(pos(Impl), Msg); +mk_error({entrypoint_cannot_be_stateful, Impl, Base, Interface}) -> + Msg = io_lib:format("`~s` cannot be stateful because the entrypoint `~s` in the " + "interface `~s` is not stateful", + [name(Impl), name(Base), name(Interface)]), + mk_t_err(pos(Impl), Msg); +mk_error({entrypoint_must_be_payable, Impl, Base, Interface}) -> + Msg = io_lib:format("`~s` must be payable because the entrypoint `~s` in the " + "interface `~s` is payable", + [name(Impl), name(Base), name(Interface)]), + mk_t_err(pos(Impl), Msg); +mk_error({unpreserved_payablity, Kind, ContractCon, InterfaceCon}) -> + KindStr = case Kind of + contract -> "contract"; + contract_interface -> "interface" + end, + Msg = io_lib:format("Non-payable ~s `~s` cannot implement payable interface `~s`", + [KindStr, name(ContractCon), name(InterfaceCon)]), + mk_t_err(pos(ContractCon), Msg); +mk_error({mutually_recursive_constants, Consts}) -> + Msg = [ "Mutual recursion detected between the constants", + [ io_lib:format("\n - `~s` at ~s", [name(Id), pp_loc(Ann)]) + || {letval, Ann, Id, _} <- Consts ] ], + [{letval, Ann, _, _} | _] = Consts, + mk_t_err(pos(Ann), Msg); +mk_error({invalid_const_id, Ann}) -> + Msg = "The name of the compile-time constant cannot have pattern matching", + mk_t_err(pos(Ann), Msg); +mk_error({invalid_const_expr, ConstId}) -> + Msg = io_lib:format("Invalid expression in the definition of the constant `~s`", [name(ConstId)]), + Cxt = "You can only use the following expressions as constants: " + "literals, lists, tuples, maps, and other constants", + mk_t_err(pos(aeso_syntax:get_ann(ConstId)), Msg, Cxt); +mk_error({illegal_const_in_interface, Ann}) -> + Msg = "Cannot define toplevel constants inside a contract interface", + mk_t_err(pos(Ann), Msg); mk_error(Err) -> Msg = io_lib:format("Unknown error: ~p", [Err]), mk_t_err(pos(0, 0), Msg). @@ -3720,6 +4036,9 @@ mk_warning({unused_stateful, Ann, FunName}) -> mk_warning({unused_variable, Ann, _Namespace, _Fun, VarName}) -> Msg = io_lib:format("The variable `~s` is defined but never used.", [VarName]), aeso_warnings:new(pos(Ann), Msg); +mk_warning({unused_constant, Ann, _Namespace, ConstName}) -> + Msg = io_lib:format("The constant `~s` is defined but never used.", [ConstName]), + aeso_warnings:new(pos(Ann), Msg); mk_warning({unused_typedef, Ann, QName, _Arity}) -> Msg = io_lib:format("The type `~s` is defined but never used.", [lists:last(QName)]), aeso_warnings:new(pos(Ann), Msg); diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index f3dd9cc..6607450 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -32,12 +32,13 @@ -type op() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | '<' | '>' | '=<' | '>=' | '==' | '!=' | '!' | + 'band' | 'bor' | 'bxor' | 'bnot' | '<<' | '>>' | map_get | map_get_d | map_set | map_from_list | map_to_list | map_delete | map_member | map_size | string_length | string_concat | bits_set | bits_clear | bits_test | bits_sum | bits_intersection | bits_union | bits_difference | contract_to_address | address_to_contract | crypto_verify_sig | crypto_verify_sig_secp256k1 | - crypto_sha3 | crypto_sha256 | crypto_blake2b | + crypto_sha3 | crypto_sha256 | crypto_blake2b | crypto_poseidon | crypto_ecverify_secp256k1 | crypto_ecrecover_secp256k1 | mcl_bls12_381_g1_neg | mcl_bls12_381_g1_norm | mcl_bls12_381_g1_valid | mcl_bls12_381_g1_is_zero | mcl_bls12_381_g1_add | mcl_bls12_381_g1_mul | @@ -58,34 +59,36 @@ | {contract_code, string()} %% for CREATE, by name | {typerep, ftype()}. --type fexpr() :: {lit, flit()} - | nil - | {var, var_name()} - | {def, fun_name(), [fexpr()]} - | {remote, [ftype()], ftype(), fexpr(), fun_name(), [fexpr()]} - | {builtin, builtin(), [fexpr()]} - | {con, arities(), tag(), [fexpr()]} - | {tuple, [fexpr()]} - | {proj, fexpr(), integer()} - | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value - | {op, op(), [fexpr()]} - | {'let', var_name(), fexpr(), fexpr()} - | {funcall, fexpr(), [fexpr()]} %% Call to unknown function - | {closure, fun_name(), fexpr()} - | {switch, fsplit()} - | {set_state, state_reg(), fexpr()} - | {get_state, state_reg()} +-type fann() :: [ {file, aeso_syntax:ann_file()} | {line, aeso_syntax:ann_line()} ]. + +-type fexpr() :: {lit, fann(), flit()} + | {nil, fann()} + | {var, fann(), var_name()} + | {def, fann(), fun_name(), [fexpr()]} + | {remote, fann(), [ftype()], ftype(), fexpr(), fun_name(), [fexpr()]} + | {builtin, fann(), builtin(), [fexpr()]} + | {con, fann(), arities(), tag(), [fexpr()]} + | {tuple, fann(), [fexpr()]} + | {proj, fann(), fexpr(), integer()} + | {set_proj, fann(), fexpr(), integer(), fexpr()} %% tuple, field, new_value + | {op, fann(), op(), [fexpr()]} + | {'let', fann(), var_name(), fexpr(), fexpr()} + | {funcall, fann(), fexpr(), [fexpr()]} %% Call to unknown function + | {closure, fann(), fun_name(), fexpr()} + | {switch, fann(), fsplit()} + | {set_state, fann(), state_reg(), fexpr()} + | {get_state, fann(), state_reg()} %% The following (unapplied top-level functions/builtins and %% lambdas) are generated by the fcode compiler, but translated %% to closures by the lambda lifter. - | {def_u, fun_name(), arity()} - | {remote_u, [ftype()], ftype(), fexpr(), fun_name()} - | {builtin_u, builtin(), arity()} - | {builtin_u, builtin(), arity(), [fexpr()]} %% Typerep arguments to be added after normal args. - | {lam, [var_name()], fexpr()}. + | {def_u, fann(), fun_name(), arity()} + | {remote_u, fann(), [ftype()], ftype(), fexpr(), fun_name()} + | {builtin_u, fann(), builtin(), arity()} + | {builtin_u, fann(), builtin(), arity(), [fexpr()]} %% Typerep arguments to be added after normal args. + | {lam, fann(), [var_name()], fexpr()}. -type fsplit() :: {split, ftype(), var_name(), [fcase()]} - | {nosplit, fexpr()}. + | {nosplit, [rename()], fexpr()}. %% Renames are needed to add DBG_DEF for switch pattern vars -type fcase() :: {'case', fsplit_pat(), fsplit()}. @@ -115,18 +118,21 @@ | bits | {variant, [[ftype()]]} | {function, [ftype()], ftype()} - | any | {tvar, var_name()}. + | any + | {tvar, var_name()}. --type fun_def() :: #{ attrs := [attribute()], +-type fun_def() :: #{ attrs := [attribute() | fann()], args := [{var_name(), ftype()}], return := ftype(), body := fexpr() }. +-type functions() :: #{ fun_name() => fun_def() }. + -type fcode() :: #{ contract_name := string(), state_type := ftype(), state_layout := state_layout(), event_type := ftype() | none, - functions := #{ fun_name() => fun_def() }, + functions := functions(), payable := boolean() }. -type type_def() :: fun(([ftype()]) -> ftype()). @@ -137,11 +143,14 @@ -record(con_tag, { tag :: tag(), arities :: arities() }). -type con_tag() :: #con_tag{}. --type type_env() :: #{ sophia_name() => type_def() }. --type fun_env() :: #{ sophia_name() => {fun_name(), non_neg_integer()} }. --type con_env() :: #{ sophia_name() => con_tag() }. --type child_con_env() :: #{sophia_name() => fcode()}. --type builtins() :: #{ sophia_name() => {builtin(), non_neg_integer() | none | variable} }. +-type expr_env() :: #{ var_name() => fexpr() }. +-type type_env() :: #{ sophia_name() => type_def() }. +-type fun_env() :: #{ sophia_name() => {fun_name(), non_neg_integer()} }. +-type con_env() :: #{ sophia_name() => con_tag() }. +-type child_con_env() :: #{ sophia_name() => fcode() }. +-type builtins() :: #{ sophia_name() => {builtin(), non_neg_integer() | none | variable} }. + +-type rename() :: [{var_name(), var_name()}]. -type context() :: {contract_def, string()} | {namespace, string()} @@ -160,6 +169,7 @@ context => context(), vars => [var_name()], functions := #{ fun_name() => fun_def() }, + consts := #{ var_name() => fexpr() }, saved_fresh_names => #{ var_name() => var_name() } }. @@ -187,6 +197,7 @@ ast_to_fcode(Code, Options) -> clear_fresh_names(Options), {Env3, FCode2}. +-spec optimize(fcode(), [option()]) -> fcode(). optimize(FCode1, Options) -> Verbose = lists:member(pp_fcode, Options), [io:format("-- Before lambda lifting --\n~s\n\n", [format_fcode(FCode1)]) || Verbose], @@ -214,6 +225,12 @@ init_env(Options) -> ["AENS", "ContractPt"] => #con_tag{ tag = 2, arities = [1, 1, 1, 1] }, ["AENS", "ChannelPt"] => #con_tag{ tag = 3, arities = [1, 1, 1, 1] }, ["AENS", "Name"] => #con_tag{ tag = 0, arities = [3] }, + ["AENSv2", "AccountPt"] => #con_tag{ tag = 0, arities = [1, 1, 1, 1, 1] }, + ["AENSv2", "OraclePt"] => #con_tag{ tag = 1, arities = [1, 1, 1, 1, 1] }, + ["AENSv2", "ContractPt"] => #con_tag{ tag = 2, arities = [1, 1, 1, 1, 1] }, + ["AENSv2", "ChannelPt"] => #con_tag{ tag = 3, arities = [1, 1, 1, 1, 1] }, + ["AENSv2", "DataPt"] => #con_tag{ tag = 4, arities = [1, 1, 1, 1, 1] }, + ["AENSv2", "Name"] => #con_tag{ tag = 0, arities = [3] }, ["Chain", "GAMetaTx"] => #con_tag{ tag = 0, arities = [2] }, ["Chain", "PayingForTx"] => #con_tag{ tag = 0, arities = [2] }, ["Chain", "SpendTx"] => #con_tag{ tag = 0, arities = ChainTxArities }, @@ -240,13 +257,17 @@ init_env(Options) -> ["Chain", "GAAttachTx"] => #con_tag{ tag = 21, arities = ChainTxArities } }, options => Options, - functions => #{} + functions => #{}, + consts => #{} }. -spec builtins() -> builtins(). builtins() -> - MkName = fun(NS, Fun) -> - list_to_atom(string:to_lower(string:join(NS ++ [Fun], "_"))) + MkName = fun + (["AENSv2"], Fun) -> + list_to_atom(string:to_lower("AENS_" ++ Fun)); + (NS, Fun) -> + list_to_atom(string:to_lower(string:join(NS ++ [Fun], "_"))) end, Scopes = [{[], [{"abort", 1}, {"require", 2}, {"exit", 1}]}, {["Chain"], [{"spend", 2}, {"balance", 1}, {"block_hash", 1}, {"coinbase", none}, @@ -258,13 +279,13 @@ builtins() -> {["Oracle"], [{"register", 4}, {"expiry", 1}, {"query_fee", 1}, {"query", 5}, {"get_question", 2}, {"respond", 4}, {"extend", 3}, {"get_answer", 2}, {"check", 1}, {"check_query", 2}]}, - {["AENS"], [{"resolve", 2}, {"preclaim", 3}, {"claim", 5}, {"transfer", 4}, + {["AENSv2"], [{"resolve", 2}, {"preclaim", 3}, {"claim", 5}, {"transfer", 4}, {"revoke", 3}, {"update", 6}, {"lookup", 1}]}, {["Map"], [{"from_list", 1}, {"to_list", 1}, {"lookup", 2}, {"lookup_default", 3}, {"delete", 2}, {"member", 2}, {"size", 1}]}, {["Crypto"], [{"verify_sig", 3}, {"verify_sig_secp256k1", 3}, {"ecverify_secp256k1", 3}, {"ecrecover_secp256k1", 2}, - {"sha3", 1}, {"sha256", 1}, {"blake2b", 1}]}, + {"sha3", 1}, {"sha256", 1}, {"blake2b", 1}, {"poseidon", 2}]}, {["MCL_BLS12_381"], [{"g1_neg", 1}, {"g1_norm", 1}, {"g1_valid", 1}, {"g1_is_zero", 1}, {"g1_add", 2}, {"g1_mul", 2}, {"g2_neg", 1}, {"g2_norm", 1}, {"g2_valid", 1}, {"g2_is_zero", 1}, {"g2_add", 2}, {"g2_mul", 2}, {"gt_inv", 1}, {"gt_add", 2}, {"gt_mul", 2}, {"gt_pow", 2}, {"gt_is_one", 1}, @@ -277,13 +298,15 @@ builtins() -> {["Bits"], [{"set", 2}, {"clear", 2}, {"test", 2}, {"sum", 1}, {"intersection", 2}, {"union", 2}, {"difference", 2}, {"none", none}, {"all", none}]}, {["Bytes"], [{"to_int", 1}, {"to_str", 1}, {"concat", 2}, {"split", 1}]}, - {["Int"], [{"to_str", 1}]}, - {["Address"], [{"to_str", 1}, {"to_contract", 1}, {"is_oracle", 1}, {"is_contract", 1}, {"is_payable", 1}]} + {["Int"], [{"to_str", 1}, {"mulmod", 2}]}, + {["Address"], [{"to_str", 1}, {"to_bytes", 1}, {"to_contract", 1}, + {"is_oracle", 1}, {"is_contract", 1}, {"is_payable", 1}]} ], maps:from_list([ {NS ++ [Fun], {MkName(NS, Fun), Arity}} || {NS, Funs} <- Scopes, {Fun, Arity} <- Funs ]). +-spec state_layout(env()) -> state_layout(). state_layout(Env) -> maps:get(state_layout, Env, {reg, 1}). -define(type(T), fun([]) -> T end). @@ -313,19 +336,24 @@ init_type_env() -> ["Chain", "ttl"] => ?type({variant, [[integer], [integer]]}), ["AENS", "pointee"] => ?type({variant, [[address], [address], [address], [address]]}), ["AENS", "name"] => ?type({variant, [[address, {variant, [[integer], [integer]]}, {map, string, {variant, [[address], [address], [address], [address]]}}]]}), + ["AENSv2", "pointee"] => ?type({variant, [[address], [address], [address], [address], [string]]}), + ["AENSv2", "name"] => ?type({variant, [[address, {variant, [[integer], [integer]]}, {map, string, {variant, [[address], [address], [address], [address], [string]]}}]]}), ["Chain", "ga_meta_tx"] => ?type({variant, [[address, integer]]}), ["Chain", "paying_for_tx"] => ?type({variant, [[address, integer]]}), ["Chain", "base_tx"] => ?type(BaseTx), - ["MCL_BLS12_381", "fr"] => ?type({bytes, 32}), - ["MCL_BLS12_381", "fp"] => ?type({bytes, 48}) + ["MCL_BLS12_381", "fr"] => ?type({bytes, 32}), + ["MCL_BLS12_381", "fp"] => ?type({bytes, 48}) }. +-spec is_no_code(env()) -> boolean(). is_no_code(Env) -> get_option(no_code, Env). +-spec get_option(atom(), env()) -> option(). get_option(Opt, Env) -> get_option(Opt, Env, false). +-spec get_option(atom(), env(), option()) -> option(). get_option(Opt, Env, Default) -> proplists:get_value(Opt, maps:get(options, Env, []), Default). @@ -372,6 +400,15 @@ to_fcode(Env, [{namespace, _, {con, _, Con}, Decls} | Code]) -> Env1 = decls_to_fcode(Env#{ context => {namespace, Con} }, Decls), to_fcode(Env1, Code). +-spec to_fann(aeso_syntax:ann()) -> fann(). +to_fann(Ann) -> + File = proplists:lookup(file, Ann), + Line = proplists:lookup(line, Ann), + [ X || X <- [File, Line], X =/= none ]. + +-spec get_fann(fexpr()) -> fann(). +get_fann(FExpr) -> element(2, FExpr). + -spec decls_to_fcode(env(), [aeso_syntax:decl()]) -> env(). decls_to_fcode(Env, Decls) -> %% First compute mapping from Sophia names to fun_names and add it to the @@ -384,8 +421,11 @@ decls_to_fcode(Env, Decls) -> decl_to_fcode(Env, {fun_decl, _, _, _}) -> Env; decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) -> typedef_to_fcode(Env, Name, Args, Def); -decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) -> - Attrs = get_attributes(Ann), +decl_to_fcode(Env = #{ functions := Funs, options := Options }, {letfun, Ann, {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) -> + Attrs = case proplists:get_value(debug_info, Options, false) of + true -> get_attributes_debug(Ann); + false -> get_attributes(Ann) + end, FName = lookup_fun(Env, qname(Env, Name)), FArgs = args_to_fcode(Env, Args), FRet = type_to_fcode(Env, Ret), @@ -395,7 +435,11 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R return => FRet, body => FBody }, NewFuns = Funs#{ FName => Def }, - Env#{ functions := NewFuns }. + Env#{ functions := NewFuns }; +decl_to_fcode(Env = #{ consts := Consts }, {letval, _, {typed, _, {id, _, X}, _}, Val}) -> + FVal = expr_to_fcode(Env, Val), + NewConsts = Consts#{ qname(Env, X) => FVal }, + Env#{ consts := NewConsts }. -spec typedef_to_fcode(env(), aeso_syntax:id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> env(). typedef_to_fcode(Env, {id, _, Name}, Xs, Def) -> @@ -436,6 +480,7 @@ typedef_to_fcode(Env, {id, _, Name}, Xs, Def) -> Env3 = compute_state_layout(Env2, Name, FDef), bind_type(Env3, Q, FDef). +-spec compute_state_layout(env(), string(), type_def()) -> env(). compute_state_layout(Env = #{ context := {contract_def, _} }, "state", Type) -> NoLayout = get_option(no_flatten_state, Env), Layout = @@ -448,6 +493,7 @@ compute_state_layout(Env = #{ context := {contract_def, _} }, "state", Type) -> Env#{ state_layout => Layout }; compute_state_layout(Env, _, _) -> Env. +-spec compute_state_layout(state_reg(), ftype() | [ftype()]) -> {state_reg(), state_layout() | [state_layout()]}. compute_state_layout(R, {tuple, [T]}) -> compute_state_layout(R, T); compute_state_layout(R, {tuple, Ts}) -> @@ -502,19 +548,23 @@ args_to_fcode(Env, Args) -> -define(make_let(X, Expr, Body), make_let(Expr, fun(X) -> Body end)). +-spec make_let(fexpr(), fun((fexpr()) -> fexpr())) -> fexpr(). make_let(Expr, Body) -> case Expr of - {var, _} -> Body(Expr); - {lit, {int, _}} -> Body(Expr); - {lit, {bool, _}} -> Body(Expr); + {var, _, _} -> Body(Expr); + {lit, _, {int, _}} -> Body(Expr); + {lit, _, {bool, _}} -> Body(Expr); _ -> X = fresh_name(), - {'let', X, Expr, Body({var, X})} + FAnn = get_fann(Expr), + {'let', FAnn, X, Expr, Body({var, FAnn, X})} end. -let_bind(X, {var, Y}, Body) -> rename([{X, Y}], Body); -let_bind(X, Expr, Body) -> {'let', X, Expr, Body}. +-spec let_bind(var_name(), fexpr(), fexpr()) -> fexpr(). +let_bind(X, {var, _, Y}, Body) -> rename([{X, Y}], Body); +let_bind(X, Expr, Body) -> {'let', get_fann(Expr), X, Expr, Body}. +-spec let_bind([{var_name(), fexpr()}], fexpr()) -> fexpr(). let_bind(Binds, Body) -> lists:foldr(fun({X, E}, Rest) -> let_bind(X, E, Rest) end, Body, Binds). @@ -528,50 +578,50 @@ expr_to_fcode(Env, Expr) -> -spec expr_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:expr()) -> fexpr(). %% Literals -expr_to_fcode(_Env, _Type, {int, _, N}) -> {lit, {int, N}}; -expr_to_fcode(_Env, _Type, {char, _, N}) -> {lit, {int, N}}; -expr_to_fcode(_Env, _Type, {bool, _, B}) -> {lit, {bool, B}}; -expr_to_fcode(_Env, _Type, {string, _, S}) -> {lit, {string, S}}; -expr_to_fcode(_Env, _Type, {account_pubkey, _, K}) -> {lit, {account_pubkey, K}}; -expr_to_fcode(_Env, _Type, {contract_pubkey, _, K}) -> {lit, {contract_pubkey, K}}; -expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {lit, {oracle_pubkey, K}}; -expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {lit, {oracle_query_id, K}}; -expr_to_fcode(_Env, _Type, {bytes, _, B}) -> {lit, {bytes, B}}; +expr_to_fcode(_Env, _Type, {int, Ann, N}) -> {lit, to_fann(Ann), {int, N}}; +expr_to_fcode(_Env, _Type, {char, Ann, N}) -> {lit, to_fann(Ann), {int, N}}; +expr_to_fcode(_Env, _Type, {bool, Ann, B}) -> {lit, to_fann(Ann), {bool, B}}; +expr_to_fcode(_Env, _Type, {string, Ann, S}) -> {lit, to_fann(Ann), {string, S}}; +expr_to_fcode(_Env, _Type, {account_pubkey, Ann, K}) -> {lit, to_fann(Ann), {account_pubkey, K}}; +expr_to_fcode(_Env, _Type, {contract_pubkey, Ann, K}) -> {lit, to_fann(Ann), {contract_pubkey, K}}; +expr_to_fcode(_Env, _Type, {oracle_pubkey, Ann, K}) -> {lit, to_fann(Ann), {oracle_pubkey, K}}; +expr_to_fcode(_Env, _Type, {oracle_query_id, Ann, K}) -> {lit, to_fann(Ann), {oracle_query_id, K}}; +expr_to_fcode(_Env, _Type, {bytes, Ann, B}) -> {lit, to_fann(Ann), {bytes, B}}; %% Variables -expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]); -expr_to_fcode(Env, Type, {qid, _, X}) -> - case resolve_var(Env, X) of - {builtin_u, B, Ar} when B =:= oracle_query; - B =:= oracle_get_question; - B =:= oracle_get_answer; - B =:= oracle_respond; - B =:= oracle_register; - B =:= oracle_check; - B =:= oracle_check_query -> +expr_to_fcode(Env, _Type, {id, Ann, X}) -> resolve_var(Env, Ann, [X]); +expr_to_fcode(Env, Type, {qid, Ann, X}) -> + case resolve_var(Env, Ann, X) of + {builtin_u, FAnn, B, Ar} when B =:= oracle_query; + B =:= oracle_get_question; + B =:= oracle_get_answer; + B =:= oracle_respond; + B =:= oracle_register; + B =:= oracle_check; + B =:= oracle_check_query -> OType = get_oracle_type(B, Type), {oracle, QType, RType} = type_to_fcode(Env, OType), - TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}], - {builtin_u, B, Ar, TypeArgs}; - {builtin_u, B = aens_resolve, Ar} -> + TypeArgs = [{lit, FAnn, {typerep, QType}}, {lit, FAnn, {typerep, RType}}], + {builtin_u, FAnn, B, Ar, TypeArgs}; + {builtin_u, FAnn, B = aens_resolve, Ar} -> {fun_t, _, _, _, ResType} = Type, AensType = type_to_fcode(Env, ResType), - TypeArgs = [{lit, {typerep, AensType}}], - {builtin_u, B, Ar, TypeArgs}; - {builtin_u, B = bytes_split, Ar} -> + TypeArgs = [{lit, FAnn, {typerep, AensType}}], + {builtin_u, FAnn, B, Ar, TypeArgs}; + {builtin_u, FAnn, B = bytes_split, Ar} -> {fun_t, _, _, _, {tuple_t, _, [{bytes_t, _, N}, _]}} = Type, - {builtin_u, B, Ar, [{lit, {int, N}}]}; + {builtin_u, FAnn, B, Ar, [{lit, FAnn, {int, N}}]}; Other -> Other end; %% Constructors expr_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon -> expr_to_fcode(Env, Type, {app, [], {typed, [], Con, Type}, []}); -expr_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Args}) when C == con; C == qcon -> +expr_to_fcode(Env, _Type, {app, _, {typed, _, {C, Ann, _} = Con, _}, Args}) when C == con; C == qcon -> #con_tag{ tag = I, arities = Arities } = lookup_con(Env, Con), Arity = lists:nth(I + 1, Arities), case length(Args) == Arity of - true -> {con, Arities, I, [expr_to_fcode(Env, Arg) || Arg <- Args]}; + true -> {con, to_fann(Ann), Arities, I, [expr_to_fcode(Env, Arg) || Arg <- Args]}; false -> internal_error({constructor_arity_mismatch, Con, length(Args), Arity}) end; @@ -580,18 +630,18 @@ expr_to_fcode(Env, _Type, {tuple, _, Es}) -> make_tuple([expr_to_fcode(Env, E) || E <- Es]); %% Records -expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) -> +expr_to_fcode(Env, Type, {proj, Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) -> case RecType of {con, _, _} when X == "address" -> - {op, contract_to_address, [expr_to_fcode(Env, Rec)]}; + {op, to_fann(Ann), contract_to_address, [expr_to_fcode(Env, Rec)]}; {con, _, _} -> {fun_t, _, _, Args, Ret} = Type, FArgs = [type_to_fcode(Env, Arg) || Arg <- Args], - {remote_u, FArgs, type_to_fcode(Env, Ret), expr_to_fcode(Env, Rec), + {remote_u, to_fann(Ann), FArgs, type_to_fcode(Env, Ret), expr_to_fcode(Env, Rec), {entrypoint, list_to_binary(X)}}; {record_t, [_]} -> expr_to_fcode(Env, Rec); %% Singleton record {record_t, _} -> - {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)} + {proj, to_fann(Ann), expr_to_fcode(Env, Rec), field_index(RecType, X)} end; expr_to_fcode(Env, {record_t, [FieldT]}, {record, _Ann, [_] = Fields}) -> @@ -605,55 +655,56 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> end, make_tuple(lists:map(FVal, FieldTypes)); -expr_to_fcode(Env, {record_t, [FieldT]}, {record, _Ann, Rec, Fields}) -> +expr_to_fcode(Env, {record_t, [FieldT]}, {record, Ann, Rec, Fields}) -> case field_value(FieldT, Fields) of false -> expr_to_fcode(Env, Rec); {set, E} -> expr_to_fcode(Env, E); - {upd, Z, E} -> {'let', Z, expr_to_fcode(Env, Rec), expr_to_fcode(bind_var(Env, Z), E)} + {upd, Z, E} -> {'let', to_fann(Ann), Z, expr_to_fcode(Env, Rec), expr_to_fcode(bind_var(Env, Z), E)} end; -expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> +expr_to_fcode(Env, {record_t, FieldTypes}, {record, Ann, Rec, Fields}) -> X = fresh_name(), - Proj = fun(I) -> {proj, {var, X}, I - 1} end, + FAnn = to_fann(Ann), + Proj = fun(I) -> {proj, FAnn, {var, FAnn, X}, I - 1} end, Comp = fun({I, false}) -> Proj(I); ({_, {set, E}}) -> expr_to_fcode(Env, E); - ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)} + ({I, {upd, Z, E}}) -> {'let', FAnn, Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)} end, Set = fun({_, false}, R) -> R; - ({I, {set, E}}, R) -> {set_proj, R, I - 1, expr_to_fcode(Env, E)}; - ({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1, - {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}} + ({I, {set, E}}, R) -> {set_proj, FAnn, R, I - 1, expr_to_fcode(Env, E)}; + ({I, {upd, Z, E}}, R) -> {set_proj, FAnn, R, I - 1, + {'let', FAnn, Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}} end, Expand = length(Fields) == length(FieldTypes), Updates = [ {I, field_value(FT, Fields)} || {I, FT} <- indexed(FieldTypes) ], Body = case Expand of - true -> {tuple, lists:map(Comp, Updates)}; - false -> lists:foldr(Set, {var, X}, Updates) + true -> {tuple, FAnn, lists:map(Comp, Updates)}; + false -> lists:foldr(Set, {var, FAnn, X}, Updates) end, - {'let', X, expr_to_fcode(Env, Rec), Body}; + {'let', FAnn, X, expr_to_fcode(Env, Rec), Body}; %% Lists -expr_to_fcode(Env, _Type, {list, _, Es}) -> - lists:foldr(fun(E, L) -> {op, '::', [expr_to_fcode(Env, E), L]} end, - nil, Es); +expr_to_fcode(Env, _Type, {list, Ann, Es}) -> + lists:foldr(fun(E, L) -> {op, to_fann(aeso_syntax:get_ann(E)), '::', [expr_to_fcode(Env, E), L]} end, + {nil, to_fann(Ann)}, Es); -expr_to_fcode(Env, _Type, {app, _, {'..', _}, [A, B]}) -> - {def_u, FromTo, _} = resolve_fun(Env, ["ListInternal", "from_to"]), - {def, FromTo, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]}; +expr_to_fcode(Env, _Type, {app, As, {'..', _}, [A, B]}) -> + {def_u, FAnn, FromTo, _} = resolve_fun(Env, As, ["ListInternal", "from_to"]), + {def, FAnn, FromTo, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]}; -expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) -> - {op, '::', [expr_to_fcode(Env, Yield), nil]}; +expr_to_fcode(Env, _Type, {list_comp, As, Yield, []}) -> + {op, to_fann(As), '::', [expr_to_fcode(Env, Yield), {nil, to_fann(As)}]}; expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) -> Arg = fresh_name(), Env1 = bind_var(Env, Arg), - Bind = {lam, [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType}, - [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]}, - {'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]})}, - {def_u, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]), - {def, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]}; + Bind = {lam, to_fann(As), [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType}, + [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]}, + {'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]})}, + {def_u, FAnn, FlatMap, _} = resolve_fun(Env, As, ["ListInternal", "flat_map"]), + {def, FAnn, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]}; expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) -> make_if(expr_to_fcode(Env, Cond), expr_to_fcode(Env, Type, {list_comp, As, Yield, Rest}), - nil + {nil, to_fann(As)} ); expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}) -> expr_to_fcode(Env, Type, {block, As, [LV, {list_comp, As, Yield, Rest}]}); @@ -667,15 +718,15 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> expr_to_fcode(Env, Else)); %% Switch -expr_to_fcode(Env, _, S = {switch, _, Expr = {typed, _, E, Type}, Alts}) -> +expr_to_fcode(Env, _, S = {switch, Ann, Expr = {typed, _, E, Type}, Alts}) -> Switch = fun(X) -> - {switch, alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts, S)} + {switch, to_fann(Ann), alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts, S)} end, case E of {id, _, X} -> Switch(X); _ -> X = fresh_name(), - {'let', X, expr_to_fcode(Env, Expr), + {'let', to_fann(Ann), X, expr_to_fcode(Env, Expr), Switch(X)} end; @@ -690,54 +741,57 @@ expr_to_fcode(Env, _Type, Expr = {app, _, {Op, _}, [_, _]}) when Op == '&&'; Op expr_to_fcode(Env, Type, {app, Ann, {Op, _}, [A, B]}) when is_atom(Op) -> case Op of '|>' -> expr_to_fcode(Env, Type, {app, Ann, B, [A]}); - _ -> {op, Op, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]} + _ -> {op, to_fann(Ann), Op, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]} end; -expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> +expr_to_fcode(Env, _Type, {app, Ann, {Op, _}, [A]}) when is_atom(Op) -> + FAnn = to_fann(Ann), case Op of - '-' -> {op, '-', [{lit, {int, 0}}, expr_to_fcode(Env, A)]}; - '!' -> {op, '!', [expr_to_fcode(Env, A)]} + '-' -> {op, FAnn, '-', [{lit, FAnn, {int, 0}}, expr_to_fcode(Env, A)]}; + 'bnot' -> {op, FAnn, 'bnot', [expr_to_fcode(Env, A)]}; + '!' -> {op, FAnn, '!', [expr_to_fcode(Env, A)]} end; %% Function calls -expr_to_fcode(Env, _, {app, _, Fun = {typed, _, FunE, {fun_t, _, NamedArgsT, ArgsT, Type}}, Args}) -> +expr_to_fcode(Env, _, {app, _, Fun = {typed, Ann, FunE, {fun_t, _, NamedArgsT, ArgsT, Type}}, Args}) -> Args1 = get_named_args(NamedArgsT, Args), FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], case expr_to_fcode(Env, Fun) of - {builtin_u, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs); - {builtin_u, chain_clone, _Ar} -> + {builtin_u, FAnn, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), FAnn, B, FArgs ++ TypeArgs); + {builtin_u, FAnn, chain_clone, _Ar} -> case ArgsT of var_args -> fcode_error({var_args_not_set, FunE}); _ -> %% Here we little cheat on the typechecker, but this inconsistency %% is to be solved in `aeso_fcode_to_fate:type_to_scode/1` FInitArgsT = aeb_fate_data:make_typerep([type_to_fcode(Env, T) || T <- ArgsT]), - builtin_to_fcode(state_layout(Env), chain_clone, [{lit, FInitArgsT}|FArgs]) + builtin_to_fcode(state_layout(Env), FAnn, chain_clone, [{lit, FAnn, FInitArgsT}|FArgs]) end; - {builtin_u, chain_create, _Ar} -> + {builtin_u, FAnn, chain_create, _Ar} -> case {ArgsT, Type} of {var_args, _} -> fcode_error({var_args_not_set, FunE}); {_, {con, _, Contract}} -> FInitArgsT = aeb_fate_data:make_typerep([type_to_fcode(Env, T) || T <- ArgsT]), - builtin_to_fcode(state_layout(Env), chain_create, [{lit, {contract_code, Contract}}, {lit, FInitArgsT}|FArgs]); + builtin_to_fcode(state_layout(Env), FAnn, chain_create, [{lit, FAnn, {contract_code, Contract}}, {lit, FAnn, FInitArgsT}|FArgs]); {_, _} -> fcode_error({not_a_contract_type, Type}) end; - {builtin_u, B, _Ar} -> builtin_to_fcode(state_layout(Env), B, FArgs); - {def_u, F, _Ar} -> {def, F, FArgs}; - {remote_u, RArgsT, RRetT, Ct, RFun} -> {remote, RArgsT, RRetT, Ct, RFun, FArgs}; + {builtin_u, FAnn, B, _Ar} -> builtin_to_fcode(state_layout(Env), FAnn, B, FArgs); + {def_u, FAnn, F, _Ar} -> {def, FAnn, F, FArgs}; + {remote_u, FAnn, RArgsT, RRetT, Ct, RFun} -> {remote, FAnn, RArgsT, RRetT, Ct, RFun, FArgs}; FFun -> %% FFun is a closure, with first component the function name and %% second component the environment - Call = fun(X) -> {funcall, {proj, {var, X}, 0}, [{proj, {var, X}, 1} | FArgs]} end, + FAnn = to_fann(Ann), + Call = fun(X) -> {funcall, FAnn, {proj, FAnn, {var, FAnn, X}, 0}, [{proj, FAnn, {var, FAnn, X}, 1} | FArgs]} end, case FFun of - {var, X} -> Call(X); - _ -> X = fresh_name(), - {'let', X, FFun, Call(X)} + {var, _, X} -> Call(X); + _ -> X = fresh_name(), + {'let', FAnn, X, FFun, Call(X)} end end; %% Maps -expr_to_fcode(_Env, _Type, {map, _, []}) -> - {builtin, map_empty, []}; +expr_to_fcode(_Env, _Type, {map, Ann, []}) -> + {builtin, to_fann(Ann), map_empty, []}; expr_to_fcode(Env, Type, {map, Ann, KVs}) -> %% Cheaper to do incremental map_update than building the list and doing %% map_from_list (I think). @@ -747,59 +801,72 @@ expr_to_fcode(Env, _Type, {map, _, Map, KVs}) -> ?make_let(Map1, expr_to_fcode(Env, Map), lists:foldr(fun(Fld, M) -> case Fld of - {field, _, [{map_get, _, K}], V} -> - {op, map_set, [M, expr_to_fcode(Env, K), expr_to_fcode(Env, V)]}; - {field_upd, _, [MapGet], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} when element(1, MapGet) == map_get -> + {field, Ann, [{map_get, _, K}], V} -> + {op, to_fann(Ann), map_set, [M, expr_to_fcode(Env, K), expr_to_fcode(Env, V)]}; + {field_upd, Ann, [MapGet], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} when element(1, MapGet) == map_get -> [map_get, _, K | Default] = tuple_to_list(MapGet), ?make_let(Key, expr_to_fcode(Env, K), begin %% Z might shadow Map1 or Key Z1 = fresh_name(), + FAnn = to_fann(Ann), GetExpr = case Default of - [] -> {op, map_get, [Map1, Key]}; - [D] -> {op, map_get_d, [Map1, Key, expr_to_fcode(Env, D)]} + [] -> {op, FAnn, map_get, [Map1, Key]}; + [D] -> {op, FAnn, map_get_d, [Map1, Key, expr_to_fcode(Env, D)]} end, - {'let', Z1, GetExpr, - {op, map_set, [M, Key, rename([{Z, Z1}], expr_to_fcode(bind_var(Env, Z), V))]}} + {'let', FAnn, Z1, GetExpr, + {op, FAnn, map_set, [M, Key, rename([{Z, Z1}], expr_to_fcode(bind_var(Env, Z), V))]}} end) end end, Map1, KVs)); -expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) -> - {op, map_get, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)]}; -expr_to_fcode(Env, _Type, {map_get, _, Map, Key, Def}) -> - {op, map_get_d, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)]}; +expr_to_fcode(Env, _Type, {map_get, Ann, Map, Key}) -> + {op, to_fann(Ann), map_get, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)]}; +expr_to_fcode(Env, _Type, {map_get, Ann, Map, Key, Def}) -> + {op, to_fann(Ann), map_get_d, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)]}; -expr_to_fcode(Env, _Type, {lam, _, Args, Body}) -> +expr_to_fcode(Env, _Type, {lam, Ann, Args, Body}) -> GetArg = fun({arg, _, {id, _, X}, _}) -> X end, Xs = lists:map(GetArg, Args), - {lam, Xs, expr_to_fcode(bind_vars(Env, Xs), Body)}; + {lam, to_fann(Ann), Xs, expr_to_fcode(bind_vars(Env, Xs), Body)}; expr_to_fcode(_Env, Type, Expr) -> error({todo, {Expr, ':', Type}}). -make_if({var, X}, Then, Else) -> - {switch, {split, boolean, X, - [{'case', {bool, false}, {nosplit, Else}}, - {'case', {bool, true}, {nosplit, Then}}]}}; +-spec make_if(fexpr(), fexpr(), fexpr()) -> fexpr(). +make_if({var, FAnn, X}, Then, Else) -> + {switch, FAnn, {split, boolean, X, + [{'case', {bool, false}, {nosplit, [], Else}}, + {'case', {bool, true}, {nosplit, [], Then}}]}}; make_if(Cond, Then, Else) -> X = fresh_name(), - {'let', X, Cond, make_if({var, X}, Then, Else)}. + FAnn = get_fann(Cond), + {'let', FAnn, X, Cond, make_if({var, FAnn, X}, Then, Else)}. -make_if_no_else({var, X}, Then) -> - {switch, {split, boolean, X, - [{'case', {bool, true}, {nosplit, Then}}]}}; +-spec make_if_no_else(fexpr(), fexpr()) -> fexpr(). +make_if_no_else({var, FAnn, X}, Then) -> + {switch, FAnn, {split, boolean, X, + [{'case', {bool, true}, {nosplit, [], Then}}]}}; make_if_no_else(Cond, Then) -> X = fresh_name(), - {'let', X, Cond, make_if_no_else({var, X}, Then)}. + FAnn = get_fann(Cond), + {'let', FAnn, X, Cond, make_if_no_else({var, FAnn, X}, Then)}. -spec make_tuple([fexpr()]) -> fexpr(). make_tuple([E]) -> E; -make_tuple(Es) -> {tuple, Es}. +make_tuple(Es) -> {tuple, [], Es}. + +-spec make_tuple_fpat([fpat()]) -> fpat(). +make_tuple_fpat([P]) -> P; +make_tuple_fpat(Ps) -> {tuple, Ps}. -spec strip_singleton_tuples(ftype()) -> ftype(). -strip_singleton_tuples({tuple, [T]}) -> strip_singleton_tuples(T); +strip_singleton_tuples({tuple, _, [T]}) -> strip_singleton_tuples(T); strip_singleton_tuples(T) -> T. +-spec get_oracle_type(OracleFun, FunT) -> OracleType when + OracleFun :: atom(), + FunT :: aeso_syntax:type(), + OracleType :: aeso_syntax:type(). get_oracle_type(oracle_register, {fun_t, _, _, _, OType}) -> OType; get_oracle_type(oracle_query, {fun_t, _, _, [OType | _], _}) -> OType; get_oracle_type(oracle_get_question, {fun_t, _, _, [OType | _], _}) -> OType; @@ -821,11 +888,13 @@ alts_to_fcode(Env, Type, X, Alts, Switch) -> | {bool, false | true} | {int, integer()} | {string, binary()} - | nil | {'::', fpat(), fpat()} + | nil + | {'::', fpat(), fpat()} | {tuple, [fpat()]} | {con, arities(), tag(), [fpat()]} | {assign, fpat(), fpat()}. +-spec remove_guards(env(), [aeso_syntax:alt()], aeso_syntax:expr()) -> [falt()]. remove_guards(_Env, [], _Switch) -> []; remove_guards(Env, [Alt = {'case', _, _, [{guarded, _, [], _Expr}]} | Rest], Switch) -> @@ -872,7 +941,7 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> Ys = [ Y || {var, Y} <- Pats ], Ren = [ {Y, X} || {Y, X} <- lists:zip(Ys, Xs), X /= Y, Y /= "_" ], %% TODO: Unreachable clauses error - {nosplit, rename(Ren, Body)}; + {nosplit, Ren, rename(Ren, Body)}; I when is_integer(I) -> {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), Type1 = strip_singleton_tuples(Type), @@ -884,10 +953,13 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> {split, Type1, X, Cases} end. --spec merge_alts(integer(), var_name(), [{fsplit_pat(), falt()}]) -> [{fsplit_pat(), [falt()]}]. +-spec merge_alts(integer(), var_name(), Alts) -> [{fsplit_pat(), [falt()]}] when + Alts :: [{fsplit_pat(), falt()}]. merge_alts(I, X, Alts) -> merge_alts(I, X, Alts, []). +-spec merge_alts(integer(), var_name(), Alts, Alts) -> [{fsplit_pat(), [falt()]}] when + Alts :: [{fsplit_pat(), falt()}]. merge_alts(I, X, Alts, Alts1) -> lists:foldr(fun(A, As) -> merge_alt(I, X, A, As) end, Alts1, Alts). @@ -901,7 +973,7 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> ({bool, B}, {bool, B}) -> match; ({int, N}, {int, N}) -> match; ({string, S}, {string, S}) -> match; - (nil, nil) -> match; + (nil, nil) -> match; ({'::', _, _}, {'::', _, _}) -> match; ({con, _, C, _}, {con, _, C, _}) -> match; ({con, _, _, _}, {con, _, _, _}) -> mismatch; @@ -918,6 +990,7 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> insert -> [{P, [A]}, {Q, As} | Rest] end. +-spec expand(integer(), var_name(), fsplit_pat(), fsplit_pat(), falt()) -> term(). expand(I, X, P, Q, Case = {'case', Ps, E}) -> {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), {Ps0r, Ren1} = rename_fpats([{Y, X} || Y /= X], Ps0), @@ -950,11 +1023,11 @@ split_alt(I, {'case', Pats, Body}) -> {SPat, {'case', Pats0 ++ InnerPats ++ Pats1, Body}}. -spec split_pat(fpat()) -> {fsplit_pat(), [fpat()]}. -split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; -split_pat({bool, B}) -> {{bool, B}, []}; -split_pat({int, N}) -> {{int, N}, []}; -split_pat({string, N}) -> {{string, N}, []}; -split_pat(nil) -> {nil, []}; +split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; +split_pat({bool, B}) -> {{bool, B}, []}; +split_pat({int, N}) -> {{int, N}, []}; +split_pat({string, N}) -> {{string, N}, []}; +split_pat(nil) -> {nil, []}; split_pat({'::', P, Q}) -> {{'::', fresh_name(), fresh_name()}, [P, Q]}; split_pat({con, As, I, Pats}) -> Xs = [fresh_name() || _ <- Pats], @@ -969,7 +1042,7 @@ split_pat({tuple, Pats}) -> split_vars({bool, _}, boolean) -> []; split_vars({int, _}, integer) -> []; split_vars({string, _}, string) -> []; -split_vars(nil, {list, _}) -> []; +split_vars(nil, {list, _}) -> []; split_vars({'::', X, Xs}, {list, T}) -> [{X, T}, {Xs, {list, T}}]; split_vars({assign, X, P}, T) -> [{X, T}, {P, T}]; split_vars({con, _, I, Xs}, {variant, Cons}) -> @@ -1007,7 +1080,7 @@ pat_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Pats}) when C #con_tag{tag = I, arities = As} = lookup_con(Env, Con), {con, As, I, [pat_to_fcode(Env, Pat) || Pat <- Pats]}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> - make_tuple([ pat_to_fcode(Env, Pat) || Pat <- Pats ]); + make_tuple_fpat([ pat_to_fcode(Env, Pat) || Pat <- Pats ]); pat_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; pat_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; pat_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; @@ -1025,7 +1098,7 @@ pat_to_fcode(Env, {record_t, Fields}, {record, _, FieldPats}) -> {set, Pat} -> Pat %% {upd, _, _} is impossible in patterns end end, - make_tuple([pat_to_fcode(Env, FieldPat(Field)) + make_tuple_fpat([pat_to_fcode(Env, FieldPat(Field)) || Field <- Fields]); pat_to_fcode(Env, _Type, {letpat, _, Id = {typed, _, {id, _, _}, _}, Pattern}) -> {assign, pat_to_fcode(Env, Id), pat_to_fcode(Env, Pattern)}; @@ -1035,6 +1108,12 @@ pat_to_fcode(_Env, Type, Pat) -> %% -- Decision trees for boolean operators -- +-type decision_tree() :: false + | true + | {atom, fexpr()} + | {'if', fexpr(), decision_tree(), decision_tree()}. + +-spec decision_op(aeso_syntax:op(), decision_tree(), decision_tree()) -> decision_tree(). decision_op('&&', {atom, A}, B) -> {'if', A, B, false}; decision_op('&&', false, _) -> false; decision_op('&&', true, B) -> B; @@ -1044,26 +1123,28 @@ decision_op('||', true, _) -> true; decision_op(Op, {'if', A, Then, Else}, B) -> {'if', A, decision_op(Op, Then, B), decision_op(Op, Else, B)}. +-spec expr_to_decision_tree(env(), aeso_syntax:expr()) -> decision_tree(). expr_to_decision_tree(Env, {app, _Ann, {Op, _}, [A, B]}) when Op == '&&'; Op == '||' -> decision_op(Op, expr_to_decision_tree(Env, A), expr_to_decision_tree(Env, B)); expr_to_decision_tree(Env, {typed, _, Expr, _}) -> expr_to_decision_tree(Env, Expr); expr_to_decision_tree(Env, Expr) -> {atom, expr_to_fcode(Env, Expr)}. -decision_tree_to_fcode(false) -> {lit, {bool, false}}; -decision_tree_to_fcode(true) -> {lit, {bool, true}}; +-spec decision_tree_to_fcode(decision_tree()) -> fexpr(). +decision_tree_to_fcode(false) -> {lit, [], {bool, false}}; +decision_tree_to_fcode(true) -> {lit, [], {bool, true}}; decision_tree_to_fcode({atom, B}) -> B; decision_tree_to_fcode({'if', A, Then, Else}) -> X = fresh_name(), - {'let', X, A, - {switch, {split, boolean, X, [{'case', {bool, false}, {nosplit, decision_tree_to_fcode(Else)}}, - {'case', {bool, true}, {nosplit, decision_tree_to_fcode(Then)}}]}}}. + {'let', get_fann(A), X, A, + {switch, get_fann(A), {split, boolean, X, [{'case', {bool, false}, {nosplit, [], decision_tree_to_fcode(Else)}}, + {'case', {bool, true}, {nosplit, [], decision_tree_to_fcode(Then)}}]}}}. %% -- Statements -- -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). -stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, Expr} | Stmts]) -> - {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; +stmts_to_fcode(Env, [{letval, Ann, {typed, _, {id, _, X}, _}, Expr} | Stmts]) -> + {'let', to_fann(Ann), X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; stmts_to_fcode(Env, [{letval, Ann, Pat, Expr} | Stmts]) -> expr_to_fcode(Env, {switch, Ann, Expr, [{'case', Ann, Pat, [{guarded, Ann, [], {block, Ann, Stmts}}]}]}); stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, [{guarded, _, [], Expr}]} | Stmts]) -> @@ -1071,24 +1152,26 @@ stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, [{guarded, _, [], Ex {typed, Ann1, Id, T} -> {arg, Ann1, Id, T}; _ -> internal_error({bad_arg, Arg}) %% pattern matching has been desugared end || Arg <- Args ], - {'let', X, expr_to_fcode(Env, {lam, Ann, LamArgs, Expr}), + {'let', to_fann(Ann), X, expr_to_fcode(Env, {lam, Ann, LamArgs, Expr}), stmts_to_fcode(bind_var(Env, X), Stmts)}; stmts_to_fcode(Env, [Expr]) -> expr_to_fcode(Env, Expr); stmts_to_fcode(Env, [Expr | Stmts]) -> - {'let', "_", expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)}. + {'let', to_fann(aeso_syntax:get_ann(Expr)), "_", expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)}. %% -- Builtins -- +-spec op_builtins() -> [BuiltinFun] when + BuiltinFun :: atom(). op_builtins() -> [map_from_list, map_to_list, map_delete, map_member, map_size, stringinternal_length, stringinternal_concat, stringinternal_to_list, stringinternal_from_list, stringinternal_sha3, stringinternal_sha256, stringinternal_blake2b, char_to_int, char_from_int, stringinternal_to_lower, stringinternal_to_upper, bits_set, bits_clear, bits_test, bits_sum, bits_intersection, bits_union, - bits_difference, int_to_str, address_to_str, crypto_verify_sig, + bits_difference, int_to_str, int_mulmod, address_to_str, address_to_bytes, crypto_verify_sig, address_to_contract, - crypto_verify_sig_secp256k1, crypto_sha3, crypto_sha256, crypto_blake2b, + crypto_verify_sig_secp256k1, crypto_sha3, crypto_sha256, crypto_blake2b, crypto_poseidon, crypto_ecverify_secp256k1, crypto_ecrecover_secp256k1, mcl_bls12_381_g1_neg, mcl_bls12_381_g1_norm, mcl_bls12_381_g1_valid, mcl_bls12_381_g1_is_zero, mcl_bls12_381_g1_add, mcl_bls12_381_g1_mul, @@ -1099,47 +1182,52 @@ op_builtins() -> mcl_bls12_381_int_to_fr, mcl_bls12_381_int_to_fp, mcl_bls12_381_fr_to_int, mcl_bls12_381_fp_to_int ]. -set_state({reg, R}, Val) -> - {set_state, R, Val}; -set_state({tuple, Ls}, Val) -> +-spec set_state(state_layout(), fann(), fexpr()) -> fexpr(). +set_state({reg, R}, FAnn, Val) -> + {set_state, FAnn, R, Val}; +set_state({tuple, Ls}, FAnn, Val) -> ?make_let(X, Val, lists:foldr(fun({I, L}, Code) -> - {'let', "_", set_state(L, {proj, X, I - 1}), Code} - end, {tuple, []}, indexed(Ls))). + {'let', FAnn, "_", set_state(L, FAnn, {proj, FAnn, X, I - 1}), Code} + end, {tuple, FAnn, []}, indexed(Ls))). -get_state({reg, R}) -> - {get_state, R}; -get_state({tuple, Ls}) -> - {tuple, [get_state(L) || L <- Ls]}. +-spec get_state(state_layout(), fann()) -> fexpr(). +get_state({reg, R}, FAnn) -> + {get_state, FAnn, R}; +get_state({tuple, Ls}, FAnn) -> + {tuple, FAnn, [get_state(L, FAnn) || L <- Ls]}. -builtin_to_fcode(Layout, set_state, [Val]) -> - set_state(Layout, Val); -builtin_to_fcode(Layout, get_state, []) -> - get_state(Layout); -builtin_to_fcode(_Layout, require, [Cond, Msg]) -> - make_if(Cond, {tuple, []}, {builtin, abort, [Msg]}); -builtin_to_fcode(_Layout, chain_event, [Event]) -> - {def, event, [Event]}; -builtin_to_fcode(_Layout, map_delete, [Key, Map]) -> - {op, map_delete, [Map, Key]}; -builtin_to_fcode(_Layout, map_member, [Key, Map]) -> - {op, map_member, [Map, Key]}; -builtin_to_fcode(_Layout, map_lookup, [Key0, Map0]) -> +-spec builtin_to_fcode(state_layout(), fann(), BuiltinFun, [fexpr()]) -> fexpr() when + BuiltinFun :: atom(). %% No need to mention all of them +builtin_to_fcode(Layout, FAnn, set_state, [Val]) -> + set_state(Layout, FAnn, Val); +builtin_to_fcode(Layout, FAnn, get_state, []) -> + get_state(Layout, FAnn); +builtin_to_fcode(_Layout, FAnn, require, [Cond, Msg]) -> + make_if(Cond, {tuple, FAnn, []}, {builtin, FAnn, abort, [Msg]}); +builtin_to_fcode(_Layout, FAnn, chain_event, [Event]) -> + {def, FAnn, event, [Event]}; +builtin_to_fcode(_Layout, FAnn, map_delete, [Key, Map]) -> + {op, FAnn, map_delete, [Map, Key]}; +builtin_to_fcode(_Layout, FAnn, map_member, [Key, Map]) -> + {op, FAnn, map_member, [Map, Key]}; +builtin_to_fcode(_Layout, FAnn, map_lookup, [Key0, Map0]) -> ?make_let(Key, Key0, ?make_let(Map, Map0, - make_if({op, map_member, [Map, Key]}, - {con, [0, 1], 1, [{op, map_get, [Map, Key]}]}, - {con, [0, 1], 0, []}))); -builtin_to_fcode(_Layout, map_lookup_default, [Key, Map, Def]) -> - {op, map_get_d, [Map, Key, Def]}; -builtin_to_fcode(_Layout, Builtin, Args) -> + make_if({op, FAnn, map_member, [Map, Key]}, + {con, FAnn, [0, 1], 1, [{op, FAnn, map_get, [Map, Key]}]}, + {con, FAnn, [0, 1], 0, []}))); +builtin_to_fcode(_Layout, FAnn, map_lookup_default, [Key, Map, Def]) -> + {op, FAnn, map_get_d, [Map, Key, Def]}; +builtin_to_fcode(_Layout, FAnn, Builtin, Args) -> case lists:member(Builtin, op_builtins()) of - true -> {op, Builtin, Args}; - false -> {builtin, Builtin, Args} + true -> {op, FAnn, Builtin, Args}; + false -> {builtin, FAnn, Builtin, Args} end. %% -- Init function -- +-spec add_init_function(env(), functions()) -> functions(). add_init_function(Env, Funs0) -> case is_no_code(Env) of true -> Funs0; @@ -1148,10 +1236,11 @@ add_init_function(Env, Funs0) -> InitName = {entrypoint, <<"init">>}, InitFun = #{ body := InitBody} = maps:get(InitName, Funs), Funs1 = Funs#{ InitName => InitFun#{ return => {tuple, []}, - body => builtin_to_fcode(state_layout(Env), set_state, [InitBody]) } }, + body => builtin_to_fcode(state_layout(Env), [], set_state, [InitBody]) } }, Funs1 end. +-spec add_default_init_function(env(), functions()) -> functions(). add_default_init_function(_Env, Funs) -> InitName = {entrypoint, <<"init">>}, case maps:get(InitName, Funs, none) of @@ -1159,38 +1248,40 @@ add_default_init_function(_Env, Funs) -> Funs#{ InitName => #{attrs => [], args => [], return => {tuple, []}, - body => {tuple, []}} }; + body => {tuple, [], []}} }; _ -> Funs end. %% -- Event function -- +-spec add_event_function(env(), ftype() | none, functions()) -> functions(). add_event_function(_Env, none, Funs) -> Funs; add_event_function(Env, EventFType, Funs) -> Funs#{ event => event_function(Env, EventFType) }. +-spec event_function(env(), ftype()) -> fun_def(). event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {variant, FCons}) -> Cons = [ {Name, I - 1, proplists:get_value(indices, Ann)} || {I, {constr_t, Ann, {con, _, Name}, _}} <- indexed(EventCons) ], Arities = [length(Ts) || Ts <- FCons], Case = fun({Name, Tag, Ixs}) -> {ok, HashValue} = eblake2:blake2b(?HASH_BYTES, list_to_binary(Name)), - Hash = {lit, {bytes, HashValue}}, + Hash = {lit, [], {bytes, HashValue}}, Vars = [ "arg" ++ integer_to_list(I) || I <- lists:seq(1, length(Ixs)) ], IVars = lists:zip(Ixs, Vars), Payload = case [ V || {notindexed, V} <- IVars ] of - [] -> {lit, {string, <<>>}}; - [V] -> {var, V} + [] -> {lit, [], {string, <<>>}}; + [V] -> {var, [], V} end, - Indices = [ {var, V} || {indexed, V} <- IVars ], - Body = {builtin, chain_event, [Payload, Hash | Indices]}, - {'case', {con, Arities, Tag, Vars}, {nosplit, Body}} + Indices = [ {var, [], V} || {indexed, V} <- IVars ], + Body = {builtin, [], chain_event, [Payload, Hash | Indices]}, + {'case', {con, [], Arities, Tag, Vars}, {nosplit, [], Body}} end, #{ attrs => [private], args => [{"e", EventType}], return => {tuple, []}, - body => {switch, {split, EventType, "e", lists:map(Case, Cons)}} }. + body => {switch, [], {split, EventType, "e", lists:map(Case, Cons)}} }. %% -- Lambda lifting --------------------------------------------------------- %% The expr_to_fcode compiler lambda expressions to {lam, Xs, Body}, but in @@ -1205,18 +1296,25 @@ lambda_lift(FCode = #{ functions := Funs, state_layout := StateLayout }) -> FCode#{ functions := maps:merge(Funs1, NewFuns) }. -define(lambda_key, '%lambdalifted'). + +-spec init_lambda_funs() -> term(). init_lambda_funs() -> put(?lambda_key, #{}). + +-spec get_lambda_funs() -> term(). get_lambda_funs() -> erase(?lambda_key). +-spec add_lambda_fun(fun_def()) -> fun_name(). add_lambda_fun(Def) -> Name = fresh_fun(), Funs = get(?lambda_key), put(?lambda_key, Funs#{ Name => Def }), Name. +-spec lambda_lift_fun(state_layout(), fun_def()) -> fun_def(). lambda_lift_fun(Layout, Def = #{ body := Body }) -> Def#{ body := lambda_lift_expr(Layout, Body) }. +-spec lifted_fun([var_name()], [var_name()], fexpr()) -> fun_def(). lifted_fun([Z], Xs, Body) -> #{ attrs => [private], args => [{Z, any} | [{X, any} || X <- Xs]], @@ -1224,65 +1322,73 @@ lifted_fun([Z], Xs, Body) -> body => Body }; lifted_fun(FVs, Xs, Body) -> Z = "%env", - Proj = fun({I, Y}, E) -> {'let', Y, {proj, {var, Z}, I - 1}, E} end, + FAnn = get_fann(Body), + Proj = fun({I, Y}, E) -> {'let', FAnn, Y, {proj, FAnn, {var, FAnn, Z}, I - 1}, E} end, #{ attrs => [private], args => [{Z, any} | [{X, any} || X <- Xs]], return => any, body => lists:foldr(Proj, Body, indexed(FVs)) }. +-spec make_closure([var_name()], [var_name()], fexpr()) -> Closure when + Closure :: fexpr(). make_closure(FVs, Xs, Body) -> Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body)), - Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, - {closure, Fun, Tup([{var, Y} || Y <- FVs])}. + FAnn = get_fann(Body), + Tup = fun([Y]) -> Y; (Ys) -> {tuple, FAnn, Ys} end, + {closure, FAnn, Fun, Tup([{var, FAnn, Y} || Y <- FVs])}. -lambda_lift_expr(Layout, {lam, Xs, Body}) -> - FVs = free_vars({lam, Xs, Body}), +-spec lambda_lift_expr(state_layout(), fexpr()) -> Closure when + Closure :: fexpr(). +lambda_lift_expr(Layout, L = {lam, _, Xs, Body}) -> + FVs = free_vars(L), make_closure(FVs, Xs, lambda_lift_expr(Layout, Body)); lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u -> - [Tag, F, Ar | _] = tuple_to_list(UExpr), + [Tag, _, F, Ar | _] = tuple_to_list(UExpr), ExtraArgs = case UExpr of - {builtin_u, _, _, TypeArgs} -> TypeArgs; - _ -> [] + {builtin_u, _, _, _, TypeArgs} -> TypeArgs; + _ -> [] end, Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ], - Args = [{var, X} || X <- Xs] ++ ExtraArgs, + Args = [{var, get_fann(UExpr), X} || X <- Xs] ++ ExtraArgs, Body = case Tag of - builtin_u -> builtin_to_fcode(Layout, F, Args); - def_u -> {def, F, Args} + builtin_u -> builtin_to_fcode(Layout, get_fann(UExpr), F, Args); + def_u -> {def, get_fann(UExpr), F, Args} end, make_closure([], Xs, Body); -lambda_lift_expr(Layout, {remote_u, ArgsT, RetT, Ct, F}) -> +lambda_lift_expr(Layout, {remote_u, FAnn, ArgsT, RetT, Ct, F}) -> FVs = free_vars(Ct), Ct1 = lambda_lift_expr(Layout, Ct), NamedArgCount = 3, Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, length(ArgsT) + NamedArgCount) ], - Args = [{var, X} || X <- Xs], - make_closure(FVs, Xs, {remote, ArgsT, RetT, Ct1, F, Args}); + Args = [{var, [], X} || X <- Xs], + make_closure(FVs, Xs, {remote, FAnn, ArgsT, RetT, Ct1, F, Args}); lambda_lift_expr(Layout, Expr) -> case Expr of - {lit, _} -> Expr; - nil -> Expr; - {var, _} -> Expr; - {closure, _, _} -> Expr; - {def, D, As} -> {def, D, lambda_lift_exprs(Layout, As)}; - {builtin, B, As} -> {builtin, B, lambda_lift_exprs(Layout, As)}; - {remote, ArgsT, RetT, Ct, F, As} -> {remote, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)}; - {con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(Layout, As)}; - {tuple, As} -> {tuple, lambda_lift_exprs(Layout, As)}; - {proj, A, I} -> {proj, lambda_lift_expr(Layout, A), I}; - {set_proj, A, I, B} -> {set_proj, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)}; - {op, Op, As} -> {op, Op, lambda_lift_exprs(Layout, As)}; - {'let', X, A, B} -> {'let', X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)}; - {funcall, A, Bs} -> {funcall, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)}; - {set_state, R, A} -> {set_state, R, lambda_lift_expr(Layout, A)}; - {get_state, _} -> Expr; - {switch, S} -> {switch, lambda_lift_expr(Layout, S)}; - {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)}; - {nosplit, A} -> {nosplit, lambda_lift_expr(Layout, A)}; - {'case', P, S} -> {'case', P, lambda_lift_expr(Layout, S)} + {lit, _, _} -> Expr; + {nil, _} -> Expr; + {var, _, _} -> Expr; + {closure, _, _, _} -> Expr; + {def, FAnn, D, As} -> {def, FAnn, D, lambda_lift_exprs(Layout, As)}; + {builtin, FAnn, B, As} -> {builtin, FAnn, B, lambda_lift_exprs(Layout, As)}; + {remote, FAnn, ArgsT, RetT, Ct, F, As} -> {remote, FAnn, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)}; + {con, FAnn, Ar, C, As} -> {con, FAnn, Ar, C, lambda_lift_exprs(Layout, As)}; + {tuple, FAnn, As} -> {tuple, FAnn, lambda_lift_exprs(Layout, As)}; + {proj, FAnn, A, I} -> {proj, FAnn, lambda_lift_expr(Layout, A), I}; + {set_proj, FAnn, A, I, B} -> {set_proj, FAnn, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)}; + {op, FAnn, Op, As} -> {op, FAnn, Op, lambda_lift_exprs(Layout, As)}; + {'let', FAnn, X, A, B} -> {'let', FAnn, X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)}; + {funcall, FAnn, A, Bs} -> {funcall, FAnn, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)}; + {set_state, FAnn, R, A} -> {set_state, FAnn, R, lambda_lift_expr(Layout, A)}; + {get_state, _, _} -> Expr; + {switch, FAnn, S} -> {switch, FAnn, lambda_lift_expr(Layout, S)}; + {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)}; + {nosplit, Rens, A} -> {nosplit, Rens, lambda_lift_expr(Layout, A)}; + {'case', P, S} -> {'case', P, lambda_lift_expr(Layout, S)} end. +-spec lambda_lift_exprs(state_layout(), [fexpr()]) -> [Closure] when + Closure :: fexpr(). lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As]. %% -- Optimisations ---------------------------------------------------------- @@ -1319,68 +1425,82 @@ optimize_fun(Fcode, Fun, Def = #{ body := Body0 }, Options) -> %% --- Inlining --- -spec inliner(fcode(), fun_name(), fexpr()) -> fexpr(). -inliner(Fcode, Fun, {def, Fun1, Args} = E) when Fun1 /= Fun -> +inliner(Fcode, Fun, {def, _, Fun1, Args} = E) when Fun1 /= Fun -> case should_inline(Fcode, Fun1) of false -> E; true -> inline(Fcode, Fun1, Args) end; inliner(_Fcode, _Fun, E) -> E. +-spec should_inline(fcode(), fun_name()) -> boolean(). should_inline(_Fcode, _Fun1) -> false == list_to_atom("true"). %% Dialyzer -inline(_Fcode, Fun, Args) -> {def, Fun, Args}. %% TODO +-spec inline(fcode(), fun_name(), Args) -> Def when + Args :: [fexpr()], + Def :: fexpr(). +inline(_Fcode, Fun, Args) -> {def, [], Fun, Args}. %% TODO %% --- Bind subexpressions --- -define(make_lets(Xs, Es, Body), make_lets(Es, fun(Xs) -> Body end)). +-spec bind_subexpressions(fexpr()) -> fexpr(). bind_subexpressions(Expr) -> bottom_up(fun bind_subexpressions/2, Expr). -bind_subexpressions(_, {tuple, Es}) -> - ?make_lets(Xs, Es, {tuple, Xs}); -bind_subexpressions(_, {set_proj, A, I, B}) -> - ?make_lets([X, Y], [A, B], {set_proj, X, I, Y}); +-spec bind_subexpressions(expr_env(), fexpr()) -> fexpr(). +bind_subexpressions(_, {tuple, FAnn, Es}) -> + ?make_lets(Xs, Es, {tuple, FAnn, Xs}); +bind_subexpressions(_, {set_proj, FAnn, A, I, B}) -> + ?make_lets([X, Y], [A, B], {set_proj, FAnn, X, I, Y}); bind_subexpressions(_, E) -> E. +-spec make_lets([fexpr()], fun(([fexpr()]) -> fexpr())) -> fexpr(). make_lets(Es, Body) -> make_lets(Es, [], Body). +-spec make_lets([fexpr()], [fexpr()], fun(([fexpr()]) -> fexpr())) -> fexpr(). make_lets([], Xs, Body) -> Body(lists:reverse(Xs)); -make_lets([{var, _} = E | Es], Xs, Body) -> +make_lets([{var, _, _} = E | Es], Xs, Body) -> make_lets(Es, [E | Xs], Body); -make_lets([{lit, _} = E | Es], Xs, Body) -> +make_lets([{lit, _, _} = E | Es], Xs, Body) -> make_lets(Es, [E | Xs], Body); make_lets([E | Es], Xs, Body) -> ?make_let(X, E, make_lets(Es, [X | Xs], Body)). %% --- Inline local functions --- +-spec inline_local_functions(fexpr()) -> fexpr(). inline_local_functions(Expr) -> bottom_up(fun inline_local_functions/2, Expr). -inline_local_functions(Env, {funcall, {proj, {var, Y}, 0}, [{proj, {var, Y}, 1} | Args]} = Expr) -> +-spec inline_local_functions(expr_env(), fexpr()) -> fexpr(). +inline_local_functions(Env, {funcall, _, {proj, _, {var, _, Y}, 0}, [{proj, _, {var, _, Y}, 1} | Args]} = Expr) -> %% TODO: Don't always inline local funs? case maps:get(Y, Env, free) of - {lam, Xs, Body} -> let_bind(lists:zip(Xs, Args), Body); - _ -> Expr + {lam, _, Xs, Body} -> let_bind(lists:zip(Xs, Args), Body); + _ -> Expr end; inline_local_functions(_, Expr) -> Expr. %% --- Let-floating --- +-spec let_floating(fexpr()) -> fexpr(). let_floating(Expr) -> bottom_up(fun let_float/2, Expr). -let_float(_, {'let', X, E, Body}) -> - pull_out_let({'let', X, {here, E}, Body}); -let_float(_, {proj, E, I}) -> - pull_out_let({proj, {here, E}, I}); -let_float(_, {set_proj, E, I, V}) -> - pull_out_let({set_proj, {here, E}, I, {here, V}}); -let_float(_, {op, Op, Es}) -> +-spec let_float(expr_env(), fexpr()) -> fexpr(). +let_float(_, {'let', FAnn, X, E, Body}) -> + pull_out_let({'let', FAnn, X, {here, E}, Body}); +let_float(_, {proj, FAnn, E, I}) -> + pull_out_let({proj, FAnn, {here, E}, I}); +let_float(_, {set_proj, FAnn, E, I, V}) -> + pull_out_let({set_proj, FAnn, {here, E}, I, {here, V}}); +let_float(_, {op, FAnn, Op, Es}) -> {Lets, Es1} = pull_out_let([{here, E} || E <- Es]), - let_bind(Lets, {op, Op, Es1}); + let_bind(Lets, {op, FAnn, Op, Es1}); let_float(_, E) -> E. +-spec pull_out_let(fexpr() | [fexpr()]) -> fexpr() | {Lets, [fexpr()]} when + Lets :: [{var_name(), fexpr()}]. pull_out_let(Expr) when is_tuple(Expr) -> {Lets, Es} = pull_out_let(tuple_to_list(Expr)), Inner = list_to_tuple(Es), @@ -1400,9 +1520,13 @@ pull_out_let(Es) when is_list(Es) -> end. %% Also renames the variables to fresh names +-spec let_view(fexpr()) -> {Lets, fexpr()} when + Lets :: [{var_name(), fexpr()}]. let_view(E) -> let_view(E, [], []). -let_view({'let', X, E, Rest}, Ren, Lets) -> +-spec let_view(fexpr(), rename(), Lets) -> {Lets, fexpr()} when + Lets :: [{var_name(), fexpr()}]. +let_view({'let', _, X, E, Rest}, Ren, Lets) -> Z = fresh_name(), let_view(Rest, [{X, Z} | Ren], [{Z, rename(Ren, E)} | Lets]); let_view(E, Ren, Lets) -> @@ -1414,62 +1538,63 @@ let_view(E, Ren, Lets) -> simplifier(Expr) -> bottom_up(fun simplify/2, Expr). --spec simplify(#{var_name() => fexpr()}, fexpr()) -> fexpr(). +-spec simplify(expr_env(), fexpr()) -> fexpr(). %% (e₀, .., en).i -> %% let _ = e₀ in .. let x = ei in .. let _ = en in x -simplify(_Env, {proj, {tuple, Es}, I}) -> +simplify(_Env, {proj, FAnn, {tuple, _, Es}, I}) -> It = lists:nth(I + 1, Es), X = fresh_name(), Dup = safe_to_duplicate(It), - Val = if Dup -> It; true -> {var, X} end, + Val = if Dup -> It; true -> {var, FAnn, X} end, lists:foldr( fun({J, E}, Rest) when I == J -> case Dup of true -> Rest; - false -> {'let', X, E, Rest} + false -> {'let', FAnn, X, E, Rest} end; ({_, E}, Rest) -> case read_only(E) of true -> Rest; - false -> {'let', "_", E, Rest} + false -> {'let', FAnn, "_", E, Rest} end end, Val, indexed(Es)); %% let x = e in .. x.i .. -simplify(Env, {proj, {var, X}, I} = Expr) -> - case simpl_proj(Env, I, {var, X}) of +simplify(Env, {proj, _, Var = {var, _, _}, I} = Expr) -> + case simpl_proj(Env, I, Var) of false -> Expr; E -> E end; -simplify(Env, {switch, Split}) -> - case simpl_switch(Env, [], Split) of - nomatch -> {builtin, abort, [{lit, {string, <<"Incomplete patterns">>}}]}; - stuck -> {switch, Split}; +simplify(Env, {switch, FAnn, Split}) -> + case simpl_switch(Env, FAnn, [], Split) of + nomatch -> {builtin, FAnn, abort, [{lit, FAnn, {string, <<"Incomplete patterns">>}}]}; Expr -> Expr end; simplify(_, E) -> E. +-spec simpl_proj(expr_env(), integer(), fexpr()) -> fexpr() | false. simpl_proj(Env, I, Expr) -> IfSafe = fun(E) -> case safe_to_duplicate(E) of true -> E; false -> false end end, case Expr of - false -> false; - {var, X} -> simpl_proj(Env, I, maps:get(X, Env, false)); - {tuple, Es} -> IfSafe(lists:nth(I + 1, Es)); - {set_proj, _, I, Val} -> IfSafe(Val); - {set_proj, E, _, _} -> simpl_proj(Env, I, E); - {proj, E, J} -> simpl_proj(Env, I, simpl_proj(Env, J, E)); - _ -> false + false -> false; + {var, _, X} -> simpl_proj(Env, I, maps:get(X, Env, false)); + {tuple, _, Es} -> IfSafe(lists:nth(I + 1, Es)); + {set_proj, _, _, I, Val} -> IfSafe(Val); + {set_proj, _, E, _, _} -> simpl_proj(Env, I, E); + {proj, _, E, J} -> simpl_proj(Env, I, simpl_proj(Env, J, E)); + _ -> false end. +-spec get_catchalls([fcase()]) -> [fcase()]. get_catchalls(Alts) -> - [ C || C = {'case', {var, _}, _} <- Alts ]. + [ C || C = {'case', {var, _, _}, _} <- Alts ]. %% The scode compiler can't handle multiple catch-alls, so we need to nest them %% inside each other. Instead of @@ -1479,6 +1604,7 @@ get_catchalls(Alts) -> %% _ => switch(x) %% .. %% _ => e +-spec add_catchalls([fcase()], [fcase()]) -> [fcase()]. add_catchalls(Alts, []) -> Alts; add_catchalls(Alts, Catchalls) -> case lists:splitwith(fun({'case', {var, _}, _}) -> false; (_) -> true end, @@ -1488,118 +1614,120 @@ add_catchalls(Alts, Catchalls) -> %% NOTE: relies on catchalls always being at the end end. -nest_catchalls([C = {'case', {var, _}, {nosplit, _}} | _]) -> C; +-spec nest_catchalls([fcase()]) -> fcase(). +nest_catchalls([C = {'case', {var, _}, {nosplit, _, _}} | _]) -> C; nest_catchalls([{'case', P = {var, _}, {split, Type, X, Alts}} | Catchalls]) -> {'case', P, {split, Type, X, add_catchalls(Alts, Catchalls)}}. -simpl_switch(_Env, _, {nosplit, E}) -> E; -simpl_switch(Env, Catchalls, {split, Type, X, Alts}) -> +-spec simpl_switch(expr_env(), fann(), [fcase()], fsplit()) -> fexpr() | nomatch. +simpl_switch(_Env, _FAnn, _, {nosplit, _, E}) -> E; +simpl_switch(Env, FAnn, Catchalls, {split, Type, X, Alts}) -> Alts1 = add_catchalls(Alts, Catchalls), - Stuck = {switch, {split, Type, X, Alts1}}, - case constructor_form(Env, {var, X}) of + Stuck = {switch, FAnn, {split, Type, X, Alts1}}, + case constructor_form(Env, {var, [], X}) of false -> Stuck; - E -> - case simpl_case(Env, E, Alts1) of - stuck -> Stuck; - Res -> Res - end + E -> simpl_case(Env, E, Alts1) end. +-spec simpl_case(expr_env(), fexpr(), [fcase()]) -> fexpr() | nomatch. simpl_case(_, _, []) -> nomatch; simpl_case(Env, E, [{'case', Pat, Body} | Alts]) -> case match_pat(Pat, E) of false -> simpl_case(Env, E, Alts); Binds -> Env1 = maps:merge(Env, maps:from_list(Binds)), - case simpl_switch(Env1, get_catchalls(Alts), Body) of + case simpl_switch(Env1, get_fann(E), get_catchalls(Alts), Body) of nomatch -> simpl_case(Env, E, Alts); - stuck -> stuck; Body1 -> let_bind(Binds, Body1) end end. -spec match_pat(fsplit_pat(), fexpr()) -> false | [{var_name(), fexpr()}]. -match_pat({tuple, Xs}, {tuple, Es}) -> lists:zip(Xs, Es); -match_pat({con, _, C, Xs}, {con, _, C, Es}) -> lists:zip(Xs, Es); -match_pat(L, {lit, L}) -> []; -match_pat(nil, nil) -> []; -match_pat({'::', X, Y}, {op, '::', [A, B]}) -> [{X, A}, {Y, B}]; -match_pat({var, X}, E) -> [{X, E}]; -match_pat({assign, X, P}, E) -> [{X, E}, {P, E}]; -match_pat(_, _) -> false. +match_pat({tuple, Xs}, {tuple, _, Es}) -> lists:zip(Xs, Es); +match_pat({con, _, C, Xs}, {con, _, _, C, Es}) -> lists:zip(Xs, Es); +match_pat(L, {lit, _, L}) -> []; +match_pat(nil, {nil, _}) -> []; +match_pat({'::', X, Y}, {op, _, '::', [A, B]}) -> [{X, A}, {Y, B}]; +match_pat({var, X}, E) -> [{X, E}]; +match_pat({assign, X, P}, E) -> [{X, E}, {P, E}]; +match_pat(_, _) -> false. +-spec constructor_form(expr_env(), fexpr()) -> fexpr() | false. constructor_form(Env, Expr) -> case Expr of - {var, X} -> + {var, _, X} -> case maps:get(X, Env, free) of free -> false; E -> constructor_form(Env, E) %% TODO: shadowing? end; - {set_proj, E, I, V} -> + {set_proj, _, E, I, V} -> case constructor_form(Env, E) of - {tuple, Es} -> {tuple, setnth(I + 1, V, Es)}; - _ -> false + {tuple, FAnn, Es} -> {tuple, FAnn, setnth(I + 1, V, Es)}; + _ -> false end; - {proj, E, I} -> + {proj, _, E, I} -> case constructor_form(Env, E) of - {tuple, Es} -> constructor_form(Env, lists:nth(I + 1, Es)); - _ -> false + {tuple, _, Es} -> constructor_form(Env, lists:nth(I + 1, Es)); + _ -> false end; - {con, _, _, _} -> Expr; - {tuple, _} -> Expr; - {lit, _} -> Expr; - nil -> Expr; - {op, '::', _} -> Expr; - _ -> false + {con, _, _, _, _} -> Expr; + {tuple, _, _} -> Expr; + {lit, _, _} -> Expr; + {nil, _} -> Expr; + {op, _, '::', _} -> Expr; + _ -> false end. %% --- Drop unused lets --- +-spec drop_unused_lets(fexpr()) -> fexpr(). drop_unused_lets(Expr) -> bottom_up(fun drop_unused_lets/2, Expr). -drop_unused_lets(_, {'let', X, E, Body} = Expr) -> +-spec drop_unused_lets(expr_env(), fexpr()) -> fexpr(). +drop_unused_lets(_, {'let', FAnn, X, E, Body} = Expr) -> case {read_only(E), not lists:member(X, free_vars(Body))} of {true, true} -> Body; - {false, true} -> {'let', "_", E, Body}; + {false, true} -> {'let', FAnn, "_", E, Body}; _ -> Expr end; drop_unused_lets(_, Expr) -> Expr. %% -- Static analysis -------------------------------------------------------- -safe_to_duplicate({lit, _}) -> true; -safe_to_duplicate({var, _}) -> true; -safe_to_duplicate(nil) -> true; -safe_to_duplicate({tuple, []}) -> true; -safe_to_duplicate(_) -> false. +-spec safe_to_duplicate(fexpr()) -> boolean(). +safe_to_duplicate({lit, _, _}) -> true; +safe_to_duplicate({var, _, _}) -> true; +safe_to_duplicate({nil, _}) -> true; +safe_to_duplicate({tuple, _, []}) -> true; +safe_to_duplicate(_) -> false. -spec read_only(fexpr() | fsplit() | fcase() | [fexpr()] | [fcase()]) -> boolean(). -read_only({lit, _}) -> true; -read_only({var, _}) -> true; -read_only(nil) -> true; -read_only({con, _, _, Es}) -> read_only(Es); -read_only({tuple, Es}) -> read_only(Es); -read_only({proj, E, _}) -> read_only(E); -read_only({set_proj, A, _, B}) -> read_only([A, B]); -read_only({op, _, Es}) -> read_only(Es); -read_only({get_state, _}) -> true; -read_only({set_state, _, _}) -> false; -read_only({def_u, _, _}) -> true; -read_only({remote_u, _, _, _, _}) -> true; -read_only({builtin_u, _, _}) -> true; -read_only({builtin_u, _, _, _}) -> true; -read_only({lam, _, _}) -> true; -read_only({def, _, _}) -> false; %% TODO: purity analysis -read_only({remote, _, _, _, _, _}) -> false; -read_only({builtin, _, _}) -> false; %% TODO: some builtins are -read_only({switch, Split}) -> read_only(Split); -read_only({split, _, _, Cases}) -> read_only(Cases); -read_only({nosplit, E}) -> read_only(E); -read_only({'case', _, Split}) -> read_only(Split); -read_only({'let', _, A, B}) -> read_only([A, B]); -read_only({funcall, _, _}) -> false; -read_only({closure, _, _}) -> internal_error(no_closures_here); -read_only(Es) when is_list(Es) -> lists:all(fun read_only/1, Es). +read_only({lit, _, _}) -> true; +read_only({var, _, _}) -> true; +read_only({nil, _}) -> true; +read_only({con, _, _, _, Es}) -> read_only(Es); +read_only({tuple, _, Es}) -> read_only(Es); +read_only({proj, _, E, _}) -> read_only(E); +read_only({set_proj, _, A, _, B}) -> read_only([A, B]); +read_only({op, _, _, Es}) -> read_only(Es); +read_only({get_state, _, _}) -> true; +read_only({set_state, _, _, _}) -> false; +read_only({def_u, _, _, _}) -> true; +read_only({remote_u, _, _, _, _, _}) -> true; +read_only({builtin_u, _, _, _}) -> true; +read_only({builtin_u, _, _, _, _}) -> true; +read_only({lam, _, _, _}) -> true; +read_only({def, _, _, _}) -> false; %% TODO: purity analysis +read_only({remote, _, _, _, _, _, _}) -> false; +read_only({builtin, _, _, _}) -> false; %% TODO: some builtins are +read_only({switch, _, Split}) -> read_only(Split); +read_only({split, _, _, Cases}) -> read_only(Cases); +read_only({nosplit, _, E}) -> read_only(E); +read_only({'case', _, Split}) -> read_only(Split); +read_only({'let', _, _, A, B}) -> read_only([A, B]); +read_only({funcall, _, _, _}) -> false; +read_only({closure, _, _, _}) -> internal_error(no_closures_here); +read_only(Es) when is_list(Es) -> lists:all(fun read_only/1, Es). %% --- Deadcode elimination --- @@ -1609,12 +1737,15 @@ eliminate_dead_code(Code = #{ functions := Funs }) -> Code#{ functions := maps:filter(fun(Name, _) -> maps:is_key(Name, UsedFuns) end, Funs) }. --spec used_functions(#{ fun_name() => fun_def() }) -> #{ fun_name() => true }. +-spec used_functions(functions()) -> Used when + Used :: #{ fun_name() => true }. used_functions(Funs) -> Exported = [ Fun || {Fun, #{ attrs := Attrs }} <- maps:to_list(Funs), not lists:member(private, Attrs) ], used_functions(#{}, Exported, Funs). +-spec used_functions(Used, [fun_name()], functions()) -> Used when + Used :: #{ fun_name() => true }. used_functions(Used, [], _) -> Used; used_functions(Used, [Name | Rest], Defs) -> case maps:is_key(Name, Used) of @@ -1675,6 +1806,7 @@ add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> FunEnv1 = maps:from_list(lists:flatmap(Entry, Decls)), Env#{ fun_env := maps:merge(FunEnv, FunEnv1) }. +-spec make_fun_name(env(), aeso_syntax:ann(), aeso_syntax:name()) -> fun_name(). make_fun_name(#{ context := Context }, Ann, Name) -> Entrypoint = proplists:get_value(entrypoint, Ann, false), case Context of @@ -1714,37 +1846,59 @@ lookup_con(#{ con_env := ConEnv }, Con) -> Tag -> Tag end. +-spec bind_vars(env(), [var_name()]) -> env(). bind_vars(Env, Xs) -> lists:foldl(fun(X, E) -> bind_var(E, X) end, Env, Xs). +-spec bind_var(env(), var_name()) -> env(). bind_var(Env = #{ vars := Vars }, X) -> Env#{ vars := [X | Vars] }. -resolve_var(#{ vars := Vars } = Env, [X]) -> +-spec resolve_var(env(), aeso_syntax:ann(), [aeso_syntax:name()]) -> fexpr(). +resolve_var(#{ vars := Vars } = Env, Ann, [X]) -> case lists:member(X, Vars) of - true -> {var, X}; - false -> resolve_fun(Env, [X]) + true -> {var, to_fann(Ann), X}; + false -> + case resolve_const(Env, [X]) of + false -> resolve_fun(Env, Ann, [X]); + Const -> Const + end end; -resolve_var(Env, Q) -> resolve_fun(Env, Q). - -resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, Q) -> - case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of - {not_found, not_found} -> internal_error({unbound_variable, Q}); - {_, {B, none}} -> builtin_to_fcode(state_layout(Env), B, []); - {_, {B, Ar}} -> {builtin_u, B, Ar}; - {{Fun, Ar}, _} -> {def_u, Fun, Ar} +resolve_var(Env, Ann, Q) -> + case resolve_const(Env, Q) of + false -> resolve_fun(Env, Ann, Q); + Const -> Const end. +resolve_const(#{ consts := Consts }, Q) -> + case maps:get(Q, Consts, not_found) of + not_found -> false; + Val -> Val + end. + +-spec resolve_fun(env(), aeso_syntax:ann(), [aeso_syntax:name()]) -> fexpr(). +resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, Ann, Q) -> + case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of + {not_found, not_found} -> internal_error({unbound_variable, Q}); + {_, {B, none}} -> builtin_to_fcode(state_layout(Env), to_fann(Ann), B, []); + {_, {B, Ar}} -> {builtin_u, to_fann(Ann), B, Ar}; + {{Fun, Ar}, _} -> {def_u, to_fann(Ann), Fun, Ar} + end. + +-spec init_fresh_names([option()]) -> term(). init_fresh_names(Options) -> proplists:get_value(debug_info, Options, false) andalso init_saved_fresh_names(), put('%fresh', 0). +-spec clear_fresh_names([option()]) -> term(). clear_fresh_names(Options) -> proplists:get_value(debug_info, Options, false) andalso clear_saved_fresh_names(), erase('%fresh'). +-spec init_saved_fresh_names() -> term(). init_saved_fresh_names() -> put(saved_fresh_names, #{}). +-spec clear_saved_fresh_names() -> term(). clear_saved_fresh_names() -> erase(saved_fresh_names). @@ -1789,96 +1943,103 @@ fsplit_pat_vars({string, _}) -> []; fsplit_pat_vars(nil) -> []; fsplit_pat_vars({'::', P, Q}) -> [P, Q]; fsplit_pat_vars({tuple, Ps}) -> Ps; -fsplit_pat_vars({con, _, _, Ps}) -> Ps. +fsplit_pat_vars({con, _, _, Ps}) -> Ps; +fsplit_pat_vars({assign, X, P}) -> [X, P]. +-spec free_vars(fexpr() | [fexpr()]) -> [var_name()]. free_vars(Xs) when is_list(Xs) -> lists:umerge([ free_vars(X) || X <- Xs ]); free_vars(Expr) -> case Expr of - {var, X} -> [X]; - {lit, _} -> []; - nil -> []; - {def, _, As} -> free_vars(As); - {def_u, _, _} -> []; - {remote, _, _, Ct, _, As} -> free_vars([Ct | As]); - {remote_u, _, _, Ct, _} -> free_vars(Ct); - {builtin, _, As} -> free_vars(As); - {builtin_u, _, _} -> []; - {builtin_u, _, _, _} -> []; %% Typereps are always literals - {con, _, _, As} -> free_vars(As); - {tuple, As} -> free_vars(As); - {proj, A, _} -> free_vars(A); - {set_proj, A, _, B} -> free_vars([A, B]); - {op, _, As} -> free_vars(As); - {'let', X, A, B} -> free_vars([A, {lam, [X], B}]); - {funcall, A, Bs} -> free_vars([A | Bs]); - {set_state, _, A} -> free_vars(A); - {get_state, _} -> []; - {lam, Xs, B} -> free_vars(B) -- lists:sort(Xs); - {closure, _, A} -> free_vars(A); - {switch, A} -> free_vars(A); - {split, _, X, As} -> free_vars([{var, X} | As]); - {nosplit, A} -> free_vars(A); - {'case', P, A} -> free_vars(A) -- lists:sort(fsplit_pat_vars(P)) + {var, _, X} -> [X]; + {lit, _, _} -> []; + {nil, _} -> []; + {def, _, _, As} -> free_vars(As); + {def_u, _, _, _} -> []; + {remote, _, _, _, Ct, _, As} -> free_vars([Ct | As]); + {remote_u, _, _, _, Ct, _} -> free_vars(Ct); + {builtin, _, _, As} -> free_vars(As); + {builtin_u, _, _, _} -> []; + {builtin_u, _, _, _, _} -> []; %% Typereps are always literals + {con, _, _, _, As} -> free_vars(As); + {tuple, _, As} -> free_vars(As); + {proj, _, A, _} -> free_vars(A); + {set_proj, _, A, _, B} -> free_vars([A, B]); + {op, _, _, As} -> free_vars(As); + {'let', FAnn, X, A, B} -> free_vars([A, {lam, FAnn, [X], B}]); + {funcall, _, A, Bs} -> free_vars([A | Bs]); + {set_state, _, _, A} -> free_vars(A); + {get_state, _, _} -> []; + {lam, _, Xs, B} -> free_vars(B) -- lists:sort(Xs); + {closure, _, _, A} -> free_vars(A); + {switch, _, A} -> free_vars(A); + {split, _, X, As} -> free_vars([{var, [], X} | As]); + {nosplit, _, A} -> free_vars(A); + {'case', P, A} -> free_vars(A) -- lists:sort(fsplit_pat_vars(P)) end. +-spec used_defs(fexpr() | [fexpr()]) -> [fun_name()]. used_defs(Xs) when is_list(Xs) -> lists:umerge([ used_defs(X) || X <- Xs ]); used_defs(Expr) -> case Expr of - {var, _} -> []; - {lit, _} -> []; - nil -> []; - {def, F, As} -> lists:umerge([F], used_defs(As)); - {def_u, F, _} -> [F]; - {remote, _, _, Ct, _, As} -> used_defs([Ct | As]); - {remote_u, _, _, Ct, _} -> used_defs(Ct); - {builtin, _, As} -> used_defs(As); - {builtin_u, _, _} -> []; - {builtin_u, _, _, _} -> []; - {con, _, _, As} -> used_defs(As); - {tuple, As} -> used_defs(As); - {proj, A, _} -> used_defs(A); - {set_proj, A, _, B} -> used_defs([A, B]); - {op, _, As} -> used_defs(As); - {'let', _, A, B} -> used_defs([A, B]); - {funcall, A, Bs} -> used_defs([A | Bs]); - {set_state, _, A} -> used_defs(A); - {get_state, _} -> []; - {lam, _, B} -> used_defs(B); - {closure, F, A} -> lists:umerge([F], used_defs(A)); - {switch, A} -> used_defs(A); - {split, _, _, As} -> used_defs(As); - {nosplit, A} -> used_defs(A); - {'case', _, A} -> used_defs(A) + {var, _, _} -> []; + {lit, _, _} -> []; + {nil, _} -> []; + {def, _, F, As} -> lists:umerge([F], used_defs(As)); + {def_u, _, F, _} -> [F]; + {remote, _, _, _, Ct, _, As} -> used_defs([Ct | As]); + {remote_u, _, _, _, Ct, _} -> used_defs(Ct); + {builtin, _, _, As} -> used_defs(As); + {builtin_u, _, _, _} -> []; + {builtin_u, _, _, _, _} -> []; + {con, _, _, _, As} -> used_defs(As); + {tuple, _, As} -> used_defs(As); + {proj, _, A, _} -> used_defs(A); + {set_proj, _, A, _, B} -> used_defs([A, B]); + {op, _, _, As} -> used_defs(As); + {'let', _, _, A, B} -> used_defs([A, B]); + {funcall, _, A, Bs} -> used_defs([A | Bs]); + {set_state, _, _, A} -> used_defs(A); + {get_state, _, _} -> []; + {lam, _, _, B} -> used_defs(B); + {closure, _, F, A} -> lists:umerge([F], used_defs(A)); + {switch, _, A} -> used_defs(A); + {split, _, _, As} -> used_defs(As); + {nosplit, _, A} -> used_defs(A); + {'case', _, A} -> used_defs(A) end. +-spec bottom_up(Fun, fexpr()) -> fexpr() when + Fun :: fun((expr_env(), fexpr()) -> fexpr()). bottom_up(F, Expr) -> bottom_up(F, #{}, Expr). +-spec bottom_up(Fun, expr_env(), fexpr()) -> fexpr() when + Fun :: fun((expr_env(), fexpr()) -> fexpr()). bottom_up(F, Env, Expr) -> F(Env, case Expr of - {lit, _} -> Expr; - nil -> Expr; - {var, _} -> Expr; - {def, D, Es} -> {def, D, [bottom_up(F, Env, E) || E <- Es]}; - {def_u, _, _} -> Expr; - {builtin, B, Es} -> {builtin, B, [bottom_up(F, Env, E) || E <- Es]}; - {builtin_u, _, _} -> Expr; + {lit, _, _} -> Expr; + {nil, _} -> Expr; + {var, _, _} -> Expr; + {def, FAnn, D, Es} -> {def, FAnn, D, [bottom_up(F, Env, E) || E <- Es]}; + {def_u, _, _, _} -> Expr; + {builtin, FAnn, B, Es} -> {builtin, FAnn, B, [bottom_up(F, Env, E) || E <- Es]}; {builtin_u, _, _, _} -> Expr; - {remote, ArgsT, RetT, Ct, Fun, Es} -> {remote, ArgsT, RetT, bottom_up(F, Env, Ct), Fun, [bottom_up(F, Env, E) || E <- Es]}; - {remote_u, ArgsT, RetT, Ct, Fun} -> {remote_u, ArgsT, RetT, bottom_up(F, Env, Ct), Fun}; - {con, Ar, I, Es} -> {con, Ar, I, [bottom_up(F, Env, E) || E <- Es]}; - {tuple, Es} -> {tuple, [bottom_up(F, Env, E) || E <- Es]}; - {proj, E, I} -> {proj, bottom_up(F, Env, E), I}; - {set_proj, R, I, E} -> {set_proj, bottom_up(F, Env, R), I, bottom_up(F, Env, E)}; - {op, Op, Es} -> {op, Op, [bottom_up(F, Env, E) || E <- Es]}; - {funcall, Fun, Es} -> {funcall, bottom_up(F, Env, Fun), [bottom_up(F, Env, E) || E <- Es]}; - {set_state, R, E} -> {set_state, R, bottom_up(F, Env, E)}; - {get_state, _} -> Expr; - {closure, F, CEnv} -> {closure, F, bottom_up(F, Env, CEnv)}; - {switch, Split} -> {switch, bottom_up(F, Env, Split)}; - {lam, Xs, B} -> {lam, Xs, bottom_up(F, Env, B)}; - {'let', X, E, Body} -> + {builtin_u, _, _, _, _} -> Expr; + {remote, FAnn, ArgsT, RetT, Ct, Fun, Es} -> {remote, FAnn, ArgsT, RetT, bottom_up(F, Env, Ct), Fun, [bottom_up(F, Env, E) || E <- Es]}; + {remote_u, FAnn, ArgsT, RetT, Ct, Fun} -> {remote_u, FAnn, ArgsT, RetT, bottom_up(F, Env, Ct), Fun}; + {con, FAnn, Ar, I, Es} -> {con, FAnn, Ar, I, [bottom_up(F, Env, E) || E <- Es]}; + {tuple, FAnn, Es} -> {tuple, FAnn, [bottom_up(F, Env, E) || E <- Es]}; + {proj, FAnn, E, I} -> {proj, FAnn, bottom_up(F, Env, E), I}; + {set_proj, FAnn, R, I, E} -> {set_proj, FAnn, bottom_up(F, Env, R), I, bottom_up(F, Env, E)}; + {op, FAnn, Op, Es} -> {op, FAnn, Op, [bottom_up(F, Env, E) || E <- Es]}; + {funcall, FAnn, Fun, Es} -> {funcall, FAnn, bottom_up(F, Env, Fun), [bottom_up(F, Env, E) || E <- Es]}; + {set_state, FAnn, R, E} -> {set_state, FAnn, R, bottom_up(F, Env, E)}; + {get_state, _, _} -> Expr; + {closure, FAnn, F, CEnv} -> {closure, FAnn, F, bottom_up(F, Env, CEnv)}; + {switch, FAnn, Split} -> {switch, FAnn, bottom_up(F, Env, Split)}; + {lam, FAnn, Xs, B} -> {lam, FAnn, Xs, bottom_up(F, Env, B)}; + {'let', FAnn, X, E, Body} -> E1 = bottom_up(F, Env, E), %% Always freshen user variables to avoid shadowing issues. ShouldFreshen = fun(Y = "%" ++ _) -> maps:is_key(Y, Env); @@ -1887,16 +2048,17 @@ bottom_up(F, Env, Expr) -> true -> Z = fresh_name_save(X), Env1 = Env#{ Z => E1 }, - {'let', Z, E1, bottom_up(F, Env1, rename([{X, Z}], Body))}; + {'let', FAnn, Z, E1, bottom_up(F, Env1, rename([{X, Z}], Body))}; false -> Env1 = Env#{ X => E1 }, - {'let', X, E1, bottom_up(F, Env1, Body)} + {'let', FAnn, X, E1, bottom_up(F, Env1, Body)} end; {split, Type, X, Cases} -> {split, Type, X, [bottom_up(F, Env, Case) || Case <- Cases]}; - {nosplit, E} -> {nosplit, bottom_up(F, Env, E)}; + {nosplit, Rens, E} -> {nosplit, Rens, bottom_up(F, Env, E)}; {'case', Pat, Split} -> {'case', Pat, bottom_up(F, Env, Split)} end). +-spec get_named_args([aeso_syntax:named_arg_t()], [aeso_syntax:arg_expr()]) -> [aeso_syntax:expr()]. get_named_args(NamedArgsT, Args) -> IsNamed = fun({named_arg, _, _, _}) -> true; (_) -> false end, @@ -1904,6 +2066,7 @@ get_named_args(NamedArgsT, Args) -> NamedArgs = [get_named_arg(NamedArg, Named) || NamedArg <- NamedArgsT], NamedArgs ++ NotNamed. +-spec get_named_arg(aeso_syntax:named_arg_t(), [aeso_syntax:arg_expr()]) -> aeso_syntax:expr(). get_named_arg({named_arg_t, _, {id, _, Name}, _, Default}, Args) -> case [ Val || {named_arg, _, {id, _, X}, Val} <- Args, X == Name ] of [Val] -> Val; @@ -1912,38 +2075,41 @@ get_named_arg({named_arg_t, _, {id, _, Name}, _, Default}, Args) -> %% -- Renaming -- --spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). +-spec rename(rename(), fexpr()) -> fexpr(). rename(Ren, Expr) -> case Expr of - {lit, _} -> Expr; - nil -> nil; - {var, X} -> {var, rename_var(Ren, X)}; - {def, D, Es} -> {def, D, [rename(Ren, E) || E <- Es]}; - {def_u, _, _} -> Expr; - {builtin, B, Es} -> {builtin, B, [rename(Ren, E) || E <- Es]}; - {builtin_u, _, _} -> Expr; - {builtin_u, _, _, _} -> Expr; - {remote, ArgsT, RetT, Ct, F, Es} -> {remote, ArgsT, RetT, rename(Ren, Ct), F, [rename(Ren, E) || E <- Es]}; - {remote_u, ArgsT, RetT, Ct, F} -> {remote_u, ArgsT, RetT, rename(Ren, Ct), F}; - {con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]}; - {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; - {proj, E, I} -> {proj, rename(Ren, E), I}; - {set_proj, R, I, E} -> {set_proj, rename(Ren, R), I, rename(Ren, E)}; - {op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]}; - {funcall, Fun, Es} -> {funcall, rename(Ren, Fun), [rename(Ren, E) || E <- Es]}; - {set_state, R, E} -> {set_state, R, rename(Ren, E)}; - {get_state, _} -> Expr; - {closure, F, Env} -> {closure, F, rename(Ren, Env)}; - {switch, Split} -> {switch, rename_split(Ren, Split)}; - {lam, Xs, B} -> + {lit, _, _} -> Expr; + {nil, FAnn} -> {nil, FAnn}; + {var, FAnn, X} -> {var, FAnn, rename_var(Ren, X)}; + {def, FAnn, D, Es} -> {def, FAnn, D, [rename(Ren, E) || E <- Es]}; + {def_u, _, _, _} -> Expr; + {builtin, FAnn, B, Es} -> {builtin, FAnn, B, [rename(Ren, E) || E <- Es]}; + {builtin_u, _, _, _} -> Expr; + {builtin_u, _, _, _, _} -> Expr; + {remote, FAnn, ArgsT, RetT, Ct, F, Es} -> {remote, FAnn, ArgsT, RetT, rename(Ren, Ct), F, [rename(Ren, E) || E <- Es]}; + {remote_u, FAnn, ArgsT, RetT, Ct, F} -> {remote_u, FAnn, ArgsT, RetT, rename(Ren, Ct), F}; + {con, FAnn, Ar, I, Es} -> {con, FAnn, Ar, I, [rename(Ren, E) || E <- Es]}; + {tuple, FAnn, Es} -> {tuple, FAnn, [rename(Ren, E) || E <- Es]}; + {proj, FAnn, E, I} -> {proj, FAnn, rename(Ren, E), I}; + {set_proj, FAnn, R, I, E} -> {set_proj, FAnn, rename(Ren, R), I, rename(Ren, E)}; + {op, FAnn, Op, Es} -> {op, FAnn, Op, [rename(Ren, E) || E <- Es]}; + {funcall, FAnn, Fun, Es} -> {funcall, FAnn, rename(Ren, Fun), [rename(Ren, E) || E <- Es]}; + {set_state, FAnn, R, E} -> {set_state, FAnn, R, rename(Ren, E)}; + {get_state, _, _} -> Expr; + {closure, FAnn, F, Env} -> {closure, FAnn, F, rename(Ren, Env)}; + {switch, FAnn, Split} -> {switch, FAnn, rename_split(Ren, Split)}; + {lam, FAnn, Xs, B} -> {Zs, Ren1} = rename_bindings(Ren, Xs), - {lam, Zs, rename(Ren1, B)}; - {'let', X, E, Body} -> + {lam, FAnn, Zs, rename(Ren1, B)}; + {'let', FAnn, X, E, Body} -> {Z, Ren1} = rename_binding(Ren, X), - {'let', Z, rename(Ren, E), rename(Ren1, Body)} + {'let', FAnn, Z, rename(Ren, E), rename(Ren1, Body)} end. +-spec rename_var(rename(), var_name()) -> var_name(). rename_var(Ren, X) -> proplists:get_value(X, Ren, X). + +-spec rename_binding(rename(), var_name()) -> {var_name(), rename()}. rename_binding(Ren, X) -> Ren1 = lists:keydelete(X, 1, Ren), case lists:keymember(X, 2, Ren) of @@ -1953,18 +2119,21 @@ rename_binding(Ren, X) -> {Z, [{X, Z} | Ren1]} end. +-spec rename_bindings(rename(), [var_name()]) -> {[var_name()], rename()}. rename_bindings(Ren, []) -> {[], Ren}; rename_bindings(Ren, [X | Xs]) -> {Z, Ren1} = rename_binding(Ren, X), {Zs, Ren2} = rename_bindings(Ren1, Xs), {[Z | Zs], Ren2}. +-spec rename_fpats(rename(), [fpat()]) -> {[fpat()], rename()}. rename_fpats(Ren, []) -> {[], Ren}; rename_fpats(Ren, [P | Ps]) -> {Q, Ren1} = rename_fpat(Ren, P), {Qs, Ren2} = rename_fpats(Ren1, Ps), {[Q | Qs], Ren2}. +-spec rename_fpat(rename(), fpat()) -> {fpat(), rename()}. rename_fpat(Ren, P = {bool, _}) -> {P, Ren}; rename_fpat(Ren, P = {int, _}) -> {P, Ren}; rename_fpat(Ren, P = {string, _}) -> {P, Ren}; @@ -1983,6 +2152,7 @@ rename_fpat(Ren, {tuple, Ps}) -> {Ps1, Ren1} = rename_fpats(Ren, Ps), {{tuple, Ps1}, Ren1}. +-spec rename_spat(rename(), fsplit_pat()) -> {fsplit_pat(), rename()}. rename_spat(Ren, P = {bool, _}) -> {P, Ren}; rename_spat(Ren, P = {int, _}) -> {P, Ren}; rename_spat(Ren, P = {string, _}) -> {P, Ren}; @@ -2005,23 +2175,32 @@ rename_spat(Ren, {assign, X, P}) -> {P1, Ren2} = rename_binding(Ren1, P), {{assign, X1, P1}, Ren2}. +-spec rename_split(rename(), fsplit()) -> fsplit(). rename_split(Ren, {split, Type, X, Cases}) -> {split, Type, rename_var(Ren, X), [rename_case(Ren, C) || C <- Cases]}; -rename_split(Ren, {nosplit, E}) -> {nosplit, rename(Ren, E)}. +rename_split(Ren, {nosplit, Rens, E}) -> + {nosplit, update_rename(Rens, Ren), rename(Ren, E)}. +-spec rename_case(rename(), fcase()) -> fcase(). rename_case(Ren, {'case', Pat, Split}) -> {Pat1, Ren1} = rename_spat(Ren, Pat), {'case', Pat1, rename_split(Ren1, Split)}. +-spec update_rename(rename(), rename()) -> rename(). +update_rename(OldRen, NewRen) -> + [{Name, proplists:get_value(Rename, NewRen, Rename)} || {Name, Rename} <- OldRen]. + %% -- Records -- -field_index({typed, _, _, RecTy}, X) -> - field_index(RecTy, X); +-spec field_index(aeso_syntax:typedef(), aeso_syntax:name()) -> integer(). field_index({record_t, Fields}, X) -> IsX = fun({field_t, _, {id, _, Y}, _}) -> X == Y end, [I] = [ I || {I, Field} <- indexed(Fields), IsX(Field) ], I - 1. %% Tuples are 0-indexed +-spec field_value(aeso_syntax:field_t(), [aeso_syntax:field(aeso_syntax:pat())]) -> Res when + Res :: {upd, aeso_syntax:name(), Expr} | {set, Expr} | false, + Expr :: aeso_syntax:expr(). field_value({field_t, _, {id, _, X}, _}, Fields) -> View = fun({field, _, [{proj, _, {id, _, Y}}], E}) -> {Y, {set, E}}; ({field_upd, _, [{proj, _, {id, _, Y}}], @@ -2033,43 +2212,58 @@ field_value({field_t, _, {id, _, X}, _}, Fields) -> %% -- Attributes -- +-spec get_attributes(aeso_syntax:ann()) -> [stateful | payable | private]. get_attributes(Ann) -> [stateful || proplists:get_value(stateful, Ann, false)] ++ [payable || proplists:get_value(payable, Ann, false)] ++ [private || not proplists:get_value(entrypoint, Ann, false)]. +-spec get_attributes_debug(aeso_syntax:ann()) -> [stateful | payable | private | fann()]. +get_attributes_debug(Ann) -> + get_attributes(Ann) ++ to_fann(Ann). + %% -- Basic utilities -- +-spec indexed([term()]) -> [{integer(), term()}]. indexed(Xs) -> lists:zip(lists:seq(1, length(Xs)), Xs). +-spec setnth(integer(), Val, Vals) -> Vals when + Val :: term(), + Vals :: [Val]. setnth(I, X, Xs) -> {Ys, [_ | Zs]} = lists:split(I - 1, Xs), Ys ++ [X] ++ Zs. -dialyzer({nowarn_function, [fcode_error/1, internal_error/1]}). +-spec fcode_error(string()) -> no_return(). fcode_error(Error) -> Pos = aeso_errors:pos(0, 0), Msg = lists:flatten(io_lib:format("Unknown error: ~p\n", [Error])), aeso_errors:throw(aeso_errors:new(code_error, Pos, Msg)). +-spec internal_error(string()) -> no_return(). internal_error(Error) -> Msg = lists:flatten(io_lib:format("~p\n", [Error])), aeso_errors:throw(aeso_errors:new(internal_error, aeso_errors:pos(0, 0), Msg)). %% -- Pretty printing -------------------------------------------------------- +-spec format_fcode(fcode()) -> string(). format_fcode(#{ functions := Funs }) -> prettypr:format(format_funs(Funs)). +-spec format_funs(functions()) -> prettypr:document(). format_funs(Funs) -> pp_above( [ pp_fun(Name, Def) || {Name, Def} <- maps:to_list(Funs) ]). +-spec format_fexpr(fexpr()) -> string(). format_fexpr(E) -> prettypr:format(pp_fexpr(E)). +-spec pp_fun(fun_name(), fun_def()) -> prettypr:document(). pp_fun(Name, #{ args := Args, return := Return, body := Body }) -> PPArg = fun({X, T}) -> pp_beside([pp_text(X), pp_text(" : "), pp_ftype(T)]) end, pp_above(pp_beside([pp_text("function "), pp_fun_name(Name), @@ -2077,85 +2271,101 @@ pp_fun(Name, #{ args := Args, return := Return, body := Body }) -> pp_text(" : "), pp_ftype(Return), pp_text(" =")]), prettypr:nest(2, pp_fexpr(Body))). +-spec pp_fun_name(fun_name()) -> prettypr:document(). pp_fun_name(event) -> pp_text(event); pp_fun_name({entrypoint, E}) -> pp_text(binary_to_list(E)); pp_fun_name({local_fun, Q}) -> pp_text(string:join(Q, ".")). +-spec pp_text(binary() | string() | atom() | integer()) -> prettypr:document(). pp_text(<<>>) -> prettypr:text("\"\""); pp_text(Bin) when is_binary(Bin) -> prettypr:text(lists:flatten(io_lib:format("~p", [binary_to_list(Bin)]))); pp_text(S) when is_list(S) -> prettypr:text(lists:concat([S])); pp_text(A) when is_atom(A) -> prettypr:text(atom_to_list(A)); pp_text(N) when is_integer(N) -> prettypr:text(integer_to_list(N)). +-spec pp_int(integer()) -> prettypr:document(). pp_int(I) -> prettypr:text(integer_to_list(I)). +-spec pp_beside([prettypr:document()]) -> prettypr:document(). pp_beside([]) -> prettypr:empty(); pp_beside([X]) -> X; pp_beside([X | Xs]) -> pp_beside(X, pp_beside(Xs)). +-spec pp_beside(prettypr:document(), prettypr:document()) -> prettypr:document(). pp_beside(A, B) -> prettypr:beside(A, B). +-spec pp_above([prettypr:document()]) -> prettypr:document(). pp_above([]) -> prettypr:empty(); pp_above([X]) -> X; pp_above([X | Xs]) -> pp_above(X, pp_above(Xs)). +-spec pp_above(prettypr:document(), prettypr:document()) -> prettypr:document(). pp_above(A, B) -> prettypr:above(A, B). +-spec pp_parens(prettypr:document()) -> prettypr:document(). pp_parens(Doc) -> pp_beside([pp_text("("), Doc, pp_text(")")]). + +-spec pp_braces(prettypr:document()) -> prettypr:document(). pp_braces(Doc) -> pp_beside([pp_text("{"), Doc, pp_text("}")]). +-spec pp_punctuate(prettypr:document(), [prettypr:document()]) -> [prettypr:document()]. pp_punctuate(_Sep, []) -> []; pp_punctuate(_Sep, [X]) -> [X]; pp_punctuate(Sep, [X | Xs]) -> [pp_beside(X, Sep) | pp_punctuate(Sep, Xs)]. +-spec pp_par([prettypr:document()]) -> prettypr:document(). pp_par([]) -> prettypr:empty(); pp_par(Xs) -> prettypr:par(Xs). -pp_fexpr({lit, {typerep, T}}) -> + +-spec pp_fexpr(fexpr()) -> prettypr:document(). +pp_fexpr({lit, _, {typerep, T}}) -> pp_ftype(T); -pp_fexpr({lit, {Tag, Lit}}) -> +pp_fexpr({lit, _, {contract_code, Contract}}) -> + pp_beside(pp_text("contract "), pp_text(Contract)); +pp_fexpr({lit, _, {Tag, Lit}}) -> aeso_pretty:expr({Tag, [], Lit}); -pp_fexpr(nil) -> +pp_fexpr({nil, _}) -> pp_text("[]"); -pp_fexpr({var, X}) -> pp_text(X); +pp_fexpr({var, _, X}) -> pp_text(X); pp_fexpr({def, Fun}) -> pp_fun_name(Fun); -pp_fexpr({def_u, Fun, Ar}) -> +pp_fexpr({def_u, _, Fun, Ar}) -> pp_beside([pp_fun_name(Fun), pp_text("/"), pp_int(Ar)]); -pp_fexpr({def, Fun, Args}) -> +pp_fexpr({def, _, Fun, Args}) -> pp_call(pp_fun_name(Fun), Args); -pp_fexpr({con, _, I, []}) -> +pp_fexpr({con, _, _, I, []}) -> pp_beside(pp_text("C"), pp_int(I)); -pp_fexpr({con, _, I, Es}) -> - pp_beside(pp_fexpr({con, [], I, []}), - pp_fexpr({tuple, Es})); -pp_fexpr({tuple, Es}) -> +pp_fexpr({con, FAnn, _, I, Es}) -> + pp_beside(pp_fexpr({con, FAnn, [], I, []}), + pp_fexpr({tuple, FAnn, Es})); +pp_fexpr({tuple, _, Es}) -> pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); -pp_fexpr({proj, E, I}) -> +pp_fexpr({proj, _, E, I}) -> pp_beside([pp_fexpr(E), pp_text("."), pp_int(I)]); -pp_fexpr({lam, Xs, A}) -> - pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"), +pp_fexpr({lam, FAnn, Xs, A}) -> + pp_par([pp_fexpr({tuple, FAnn, [{var, FAnn, X} || X <- Xs]}), pp_text("=>"), prettypr:nest(2, pp_fexpr(A))]); -pp_fexpr({closure, Fun, ClEnv}) -> +pp_fexpr({closure, _, Fun, ClEnv}) -> FVs = case ClEnv of - {tuple, Xs} -> Xs; - {var, _} -> [ClEnv] + {tuple, _, Xs} -> Xs; + {var, _, _} -> [ClEnv] end, pp_call(pp_text("__CLOSURE__"), [{def, Fun} | FVs]); -pp_fexpr({set_proj, E, I, A}) -> +pp_fexpr({set_proj, _, E, I, A}) -> pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_int(I), pp_text(" = "), pp_fexpr(A)]))); -pp_fexpr({op, Op, [A, B] = Args}) -> +pp_fexpr({op, _, Op, [A, B] = Args}) -> case is_infix(Op) of false -> pp_call(pp_text(Op), Args); true -> pp_parens(pp_par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])) end; -pp_fexpr({op, Op, [A] = Args}) -> +pp_fexpr({op, _, Op, [A] = Args}) -> case is_infix(Op) of false -> pp_call(pp_text(Op), Args); true -> pp_parens(pp_par([pp_text(Op), pp_fexpr(A)])) end; -pp_fexpr({op, Op, As}) -> - pp_beside(pp_text(Op), pp_fexpr({tuple, As})); -pp_fexpr({'let', _, _, _} = Expr) -> - Lets = fun Lets({'let', Y, C, D}) -> +pp_fexpr({op, FAnn, Op, As}) -> + pp_beside(pp_text(Op), pp_fexpr({tuple, FAnn, As})); +pp_fexpr({'let', _, _, _, _} = Expr) -> + Lets = fun Lets({'let', _, Y, C, D}) -> {Ls, E} = Lets(D), {[{Y, C} | Ls], E}; Lets(E) -> {[], E} end, @@ -2166,29 +2376,29 @@ pp_fexpr({'let', _, _, _} = Expr) -> pp_above([ pp_par([pp_text(X), pp_text("="), prettypr:nest(2, pp_fexpr(A))]) || {X, A} <- Ls ]), pp_text(" in ") ]), pp_fexpr(Body) ])); -pp_fexpr({builtin_u, B, N}) -> +pp_fexpr({builtin_u, _, B, N}) -> pp_beside([pp_text(B), pp_text("/"), pp_text(N)]); -pp_fexpr({builtin_u, B, N, TypeArgs}) -> - pp_beside([pp_text(B), pp_text("@"), pp_fexpr({tuple, TypeArgs}), pp_text("/"), pp_text(N)]); -pp_fexpr({builtin, B, As}) -> +pp_fexpr({builtin_u, FAnn, B, N, TypeArgs}) -> + pp_beside([pp_text(B), pp_text("@"), pp_fexpr({tuple, FAnn, TypeArgs}), pp_text("/"), pp_text(N)]); +pp_fexpr({builtin, _, B, As}) -> pp_call(pp_text(B), As); -pp_fexpr({remote_u, ArgsT, RetT, Ct, Fun}) -> +pp_fexpr({remote_u, _, ArgsT, RetT, Ct, Fun}) -> pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text(" : "), pp_ftype({function, ArgsT, RetT})]); -pp_fexpr({remote, ArgsT, RetT, Ct, Fun, As}) -> +pp_fexpr({remote, _, ArgsT, RetT, Ct, Fun, As}) -> pp_call(pp_parens(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text(" : "), pp_ftype({function, ArgsT, RetT})])), As); -pp_fexpr({funcall, Fun, As}) -> +pp_fexpr({funcall, _, Fun, As}) -> pp_call(pp_fexpr(Fun), As); -pp_fexpr({set_state, R, A}) -> - pp_call(pp_text("set_state"), [{lit, {int, R}}, A]); -pp_fexpr({get_state, R}) -> - pp_call(pp_text("get_state"), [{lit, {int, R}}]); -pp_fexpr({switch, Split}) -> pp_split(Split); -pp_fexpr({contract_code, Contract}) -> - pp_beside(pp_text("contract "), pp_text(Contract)). +pp_fexpr({set_state, FAnn, R, A}) -> + pp_call(pp_text("set_state"), [{lit, FAnn, {int, R}}, A]); +pp_fexpr({get_state, FAnn, R}) -> + pp_call(pp_text("get_state"), [{lit, FAnn, {int, R}}]); +pp_fexpr({switch, _, Split}) -> pp_split(Split). +-spec pp_call(prettypr:document(), [fexpr()]) -> prettypr:document(). pp_call(Fun, Args) -> - pp_beside(Fun, pp_fexpr({tuple, Args})). + pp_beside(Fun, pp_fexpr({tuple, [], Args})). +-spec pp_call_t(string(), [ftype()]) -> prettypr:document(). pp_call_t(Fun, Args) -> pp_beside(pp_text(Fun), pp_ftype({tuple, Args})). @@ -2196,7 +2406,7 @@ pp_call_t(Fun, Args) -> pp_ftype(T) when is_atom(T) -> pp_text(T); pp_ftype(any) -> pp_text("_"); pp_ftype({tvar, X}) -> pp_text(X); -pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, {int, N}}]); +pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, [], {int, N}}]); pp_ftype({oracle, Q, R}) -> pp_call_t("oracle", [Q, R]); pp_ftype({tuple, Ts}) -> pp_parens(pp_par(pp_punctuate(pp_text(" *"), [pp_ftype(T) || T <- Ts]))); @@ -2210,27 +2420,36 @@ pp_ftype({variant, Cons}) -> pp_par( pp_punctuate(pp_text(" |"), [ case Args of - [] -> pp_fexpr({con, [], I - 1, []}); - _ -> pp_beside(pp_fexpr({con, [], I - 1, []}), pp_ftype({tuple, Args})) - end || {I, Args} <- indexed(Cons)])). + [] -> pp_fexpr({con, [], [], I - 1, []}); + _ -> pp_beside(pp_fexpr({con, [], [], I - 1, []}), pp_ftype({tuple, Args})) + end || {I, Args} <- indexed(Cons)])); +pp_ftype([]) -> + %% NOTE: This could happen with `{typerep, []}` since `[]` is not a ftype(). + %% TODO: It would be better to make sure that `{typerep, []}` does not arrive here. + pp_text("[]"). -pp_split({nosplit, E}) -> pp_fexpr(E); +-spec pp_split(fsplit()) -> prettypr:document(). +pp_split({nosplit, _, E}) -> pp_fexpr(E); pp_split({split, Type, X, Alts}) -> pp_above([pp_beside([pp_text("switch("), pp_text(X), pp_text(" : "), pp_ftype(Type), pp_text(")")])] ++ [prettypr:nest(2, pp_case(Alt)) || Alt <- Alts]). +-spec pp_case(fcase()) -> prettypr:document(). pp_case({'case', Pat, Split}) -> prettypr:sep([pp_beside(pp_pat(Pat), pp_text(" =>")), prettypr:nest(2, pp_split(Split))]). -pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); -pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', [{var, X}, {var, Xs}]}); -pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]}); -pp_pat({var, X}) -> pp_fexpr({var, X}); +-spec pp_pat(fsplit_pat()) -> prettypr:document(). +pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [], [{var, [], X} || X <- Xs]}); +pp_pat({'::', X, Xs}) -> pp_fexpr({op, [], '::', [{var, [], X}, {var, [], Xs}]}); +pp_pat({con, As, I, Xs}) -> pp_fexpr({con, [], As, I, [{var, [], X} || X <- Xs]}); +pp_pat({var, X}) -> pp_fexpr({var, [], X}); pp_pat(P = {Tag, _}) when Tag == bool; Tag == int; Tag == string - -> pp_fexpr({lit, P}); -pp_pat(Pat) -> pp_fexpr(Pat). + -> pp_fexpr({lit, [], P}); +pp_pat(nil) -> pp_fexpr({nil, []}); +pp_pat({assign, X, Y}) -> pp_beside([pp_text(X), pp_text(" = "), pp_text(Y)]). +-spec is_infix(op()) -> boolean(). is_infix(Op) -> C = hd(atom_to_list(Op)), C < $a orelse C > $z. diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 31b4ef8..1ff6ec3 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -12,6 +12,8 @@ , file/2 , from_string/2 , check_call/4 + , decode_value/4 + , encode_value/4 , create_calldata/3 , create_calldata/4 , version/0 @@ -117,7 +119,7 @@ from_string1(ContractString, Options) -> , warnings := Warnings } = string_to_code(ContractString, Options), #{ child_con_env := ChildContracts } = FCodeEnv, SavedFreshNames = maps:get(saved_fresh_names, FCodeEnv, #{}), - {FateCode, VarsRegs} = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options), + FateCode = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options), pp_assembler(FateCode, Options), ByteCode = aeb_fate_code:serialize(FateCode, []), {ok, Version} = version(), @@ -130,13 +132,7 @@ from_string1(ContractString, Options) -> payable => maps:get(payable, FCode), warnings => Warnings }, - ResDbg = Res#{variables_registers => VarsRegs}, - FinalRes = - case proplists:get_value(debug_info, Options, false) of - true -> ResDbg; - false -> Res - end, - {ok, maybe_generate_aci(FinalRes, FoldedTypedAst, Options)}. + {ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}. maybe_generate_aci(Result, FoldedTypedAst, Options) -> case proplists:get_value(aci, Options) of @@ -188,30 +184,55 @@ 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, [ aeso_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(ContractString0, Options), - {FateCode, _} = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []), + , ast := Ast} = string_to_code(Contract0, Options), + FateCode = aeso_fcode_to_fate:compile(ChildContracts, 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(Ast, ContractString0, CallName, FunName, Args), - #{fcode := Fcode} = string_to_code(ContractString, Options), - CallArgs = arguments_of_body(CallName, FunName, Fcode), - - {ok, FunName, CallArgs} + Contract = insert_call_function(Ast, Contract0, CallName, Call), + {ok, CallName, string_to_code(Contract, Options)} catch throw:{error, Errors} -> {error, Errors} end. -arguments_of_body(CallName, _FunName, Fcode) -> +get_call_body(CallName, #{fcode := 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 ]. + 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, aeb_fate_encoding:serialize(aeso_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} -> + #{ unfolded_typed_ast := TypedAst + , type_env := TypeEnv} = Code, + {ok, _, Type0} = get_decode_type(CallName, TypedAst), + Type1 = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_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); @@ -224,14 +245,31 @@ first_none_match(CallName, Hashes, [Char|Chars]) -> end. %% Add the __call function to a contract. --spec insert_call_function(aeso_syntax:ast(), string(), string(), string(), [string()]) -> string(). -insert_call_function(Ast, Code, Call, FunName, Args) -> +-spec insert_call_function(aeso_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, ") = val\n" ]). -spec insert_init_function(string(), options()) -> string(). @@ -274,22 +312,25 @@ to_sophia_value(ContractString, FunName, ok, Data, Options0) -> {ok, _, Type0} = get_decode_type(FunName, TypedAst), Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]), - try - {ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))} - catch throw:cannot_translate_to_sophia -> - Type1 = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s", - [aeb_fate_encoding:deserialize(Data), Type1]), - {error, [aeso_errors:new(data_error, Msg)]}; - _:_ -> - Type1 = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]), - {error, [aeso_errors:new(data_error, Msg)]} - end + 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, aeso_vm_decode:from_fate(UnfoldedType, aeb_fate_encoding:deserialize(FateData))} + catch throw:cannot_translate_to_sophia -> + Type1 = prettypr:format(aeso_pretty:type(Type)), + Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s", + [aeb_fate_encoding:deserialize(FateData), Type1]), + {error, [aeso_errors:new(data_error, Msg)]}; + _:_ -> + Type1 = prettypr:format(aeso_pretty:type(Type)), + Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]), + {error, [aeso_errors:new(data_error, Msg)]} + end. + -spec create_calldata(string(), string(), [string()]) -> {ok, binary()} | {error, [aeso_errors:error()]}. create_calldata(Code, Fun, Args) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index ebc4ebf..5034c50 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -52,7 +52,8 @@ tailpos = true, child_contracts = #{}, saved_fresh_names = #{}, - options = [] }). + options = [], + debug_info = false }). %% -- Debugging -------------------------------------------------------------- @@ -81,24 +82,16 @@ code_error(Err) -> compile(FCode, SavedFreshNames, Options) -> compile(#{}, FCode, SavedFreshNames, Options). compile(ChildContracts, FCode, SavedFreshNames, Options) -> - try - compile1(ChildContracts, FCode, SavedFreshNames, Options) - after - put(variables_registers, undefined) - end. - -compile1(ChildContracts, FCode, SavedFreshNames, Options) -> #{ contract_name := ContractName, functions := Functions } = FCode, SFuns = functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Options), SFuns1 = optimize_scode(SFuns, Options), FateCode = to_basic_blocks(SFuns1), ?debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]), - FateCode1 = case proplists:get_value(include_child_contract_symbols, Options, false) of - false -> FateCode; - true -> add_child_symbols(ChildContracts, FateCode) - end, - {FateCode1, get_variables_registers()}. + case proplists:get_value(include_child_contract_symbols, Options, false) of + false -> FateCode; + true -> add_child_symbols(ChildContracts, FateCode) + end. make_function_id(X) -> aeb_fate_code:symbol_identifier(make_function_name(X)). @@ -123,31 +116,15 @@ functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Opt function_to_scode(ChildContracts, ContractName, Functions, Name, Attrs0, Args, Body, ResType, SavedFreshNames, Options) -> {ArgTypes, ResType1} = typesig_to_scode(Args, ResType), - Attrs = Attrs0 -- [stateful], %% Only track private and payable from here. + Attrs = [ A || A <- Attrs0, A == private orelse A == payable ], Env = init_env(ChildContracts, ContractName, Functions, Name, Args, SavedFreshNames, Options), - [ add_variables_register(Env, Arg, Register) || - proplists:get_value(debug_info, Options, false), - {Arg, Register} <- Env#env.vars ], + ArgsNames = [ X || {X, _} <- lists:reverse(Env#env.vars) ], + + %% DBG_LOC is added before the function body to make it possible to break + %% at the function signature SCode = to_scode(Env, Body), - {Attrs, {ArgTypes, ResType1}, SCode}. - -get_variables_registers() -> - case get(variables_registers) of - undefined -> #{}; - Vs -> Vs - end. - -add_variables_register(Env = #env{saved_fresh_names = SavedFreshNames}, Name, Register) -> - Olds = get_variables_registers(), - RealName = maps:get(Name, SavedFreshNames, Name), - FunName = - case Env#env.current_function of - event -> "Chain.event"; - {entrypoint, BinName} -> binary_to_list(BinName); - {local_fun, QualName} -> lists:last(QualName) - end, - New = {Env#env.contract, FunName, RealName}, - put(variables_registers, Olds#{New => Register}). + DbgSCode = dbg_contract(Env) ++ dbg_loc(Env, Attrs0) ++ dbg_scoped_vars(Env, ArgsNames, SCode), + {Attrs, {ArgTypes, ResType1}, DbgSCode}. -define(tvars, '$tvars'). @@ -194,20 +171,20 @@ types_to_scode(Ts) -> lists:map(fun type_to_scode/1, Ts). %% -- Environment functions -- init_env(ChildContracts, ContractName, FunNames, Name, Args, SavedFreshNames, Options) -> - #env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], - contract = ContractName, - child_contracts = ChildContracts, - locals = FunNames, - current_function = Name, - options = Options, - tailpos = true, - saved_fresh_names = SavedFreshNames }. + #env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], + contract = ContractName, + child_contracts = ChildContracts, + locals = FunNames, + current_function = Name, + options = Options, + tailpos = true, + saved_fresh_names = SavedFreshNames, + debug_info = proplists:get_value(debug_info, Options, false) }. next_var(#env{ vars = Vars }) -> 1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]). bind_var(Name, Var, Env = #env{ vars = Vars }) -> - proplists:get_value(debug_info, Env#env.options, false) andalso add_variables_register(Env, Name, Var), Env#env{ vars = [{Name, Var} | Vars] }. bind_local(Name, Env) -> @@ -234,7 +211,7 @@ serialize_contract_code(Env, C) -> Options = Env#env.options, SavedFreshNames = Env#env.saved_fresh_names, FCode = maps:get(C, Env#env.child_contracts), - {FateCode, _} = compile1(Env#env.child_contracts, FCode, SavedFreshNames, Options), + FateCode = compile(Env#env.child_contracts, FCode, SavedFreshNames, Options), ByteCode = aeb_fate_code:serialize(FateCode, []), {ok, Version} = aeso_compiler:version(), OriginalSourceCode = proplists:get_value(original_src, Options, ""), @@ -268,44 +245,44 @@ lit_to_fate(Env, L) -> term_to_fate(E) -> term_to_fate(#env{}, #{}, E). term_to_fate(GlobEnv, E) -> term_to_fate(GlobEnv, #{}, E). -term_to_fate(GlobEnv, _Env, {lit, L}) -> +term_to_fate(GlobEnv, _Env, {lit, _, L}) -> lit_to_fate(GlobEnv, L); %% negative literals are parsed as 0 - N -term_to_fate(_GlobEnv, _Env, {op, '-', [{lit, {int, 0}}, {lit, {int, N}}]}) -> +term_to_fate(_GlobEnv, _Env, {op, _, '-', [{lit, _, {int, 0}}, {lit, _, {int, N}}]}) -> aeb_fate_data:make_integer(-N); -term_to_fate(_GlobEnv, _Env, nil) -> +term_to_fate(_GlobEnv, _Env, {nil, _}) -> aeb_fate_data:make_list([]); -term_to_fate(GlobEnv, Env, {op, '::', [Hd, Tl]}) -> +term_to_fate(GlobEnv, Env, {op, _, '::', [Hd, Tl]}) -> %% The Tl will translate into a list, because FATE lists are just lists [term_to_fate(GlobEnv, Env, Hd) | term_to_fate(GlobEnv, Env, Tl)]; -term_to_fate(GlobEnv, Env, {tuple, As}) -> +term_to_fate(GlobEnv, Env, {tuple, _, As}) -> aeb_fate_data:make_tuple(list_to_tuple([ term_to_fate(GlobEnv, Env, A) || A<-As])); -term_to_fate(GlobEnv, Env, {con, Ar, I, As}) -> +term_to_fate(GlobEnv, Env, {con, _, Ar, I, As}) -> FateAs = [ term_to_fate(GlobEnv, Env, A) || A <- As ], aeb_fate_data:make_variant(Ar, I, list_to_tuple(FateAs)); -term_to_fate(_GlobEnv, _Env, {builtin, bits_all, []}) -> +term_to_fate(_GlobEnv, _Env, {builtin, _, bits_all, []}) -> aeb_fate_data:make_bits(-1); -term_to_fate(_GlobEnv, _Env, {builtin, bits_none, []}) -> +term_to_fate(_GlobEnv, _Env, {builtin, _, bits_none, []}) -> aeb_fate_data:make_bits(0); -term_to_fate(GlobEnv, _Env, {op, bits_set, [B, I]}) -> +term_to_fate(GlobEnv, _Env, {op, _, bits_set, [B, I]}) -> {bits, N} = term_to_fate(GlobEnv, B), J = term_to_fate(GlobEnv, I), {bits, N bor (1 bsl J)}; -term_to_fate(GlobEnv, _Env, {op, bits_clear, [B, I]}) -> +term_to_fate(GlobEnv, _Env, {op, _, bits_clear, [B, I]}) -> {bits, N} = term_to_fate(GlobEnv, B), J = term_to_fate(GlobEnv, I), {bits, N band bnot (1 bsl J)}; -term_to_fate(GlobEnv, Env, {'let', X, E, Body}) -> +term_to_fate(GlobEnv, Env, {'let', _, X, E, Body}) -> Env1 = Env#{ X => term_to_fate(GlobEnv, Env, E) }, term_to_fate(GlobEnv, Env1, Body); -term_to_fate(_GlobEnv, Env, {var, X}) -> +term_to_fate(_GlobEnv, Env, {var, _, X}) -> case maps:get(X, Env, undefined) of undefined -> throw(not_a_fate_value); V -> V end; -term_to_fate(_GlobEnv, _Env, {builtin, map_empty, []}) -> +term_to_fate(_GlobEnv, _Env, {builtin, _, map_empty, []}) -> aeb_fate_data:make_map(#{}); -term_to_fate(GlobEnv, Env, {op, map_set, [M, K, V]}) -> +term_to_fate(GlobEnv, Env, {op, _, map_set, [M, K, V]}) -> Map = term_to_fate(GlobEnv, Env, M), Map#{term_to_fate(GlobEnv, Env, K) => term_to_fate(GlobEnv, Env, V)}; term_to_fate(_GlobEnv, _Env, _) -> @@ -313,52 +290,59 @@ term_to_fate(_GlobEnv, _Env, _) -> to_scode(Env, T) -> try term_to_fate(Env, T) of - V -> [push(?i(V))] + V -> + FAnn = element(2, T), + [dbg_loc(Env, FAnn), push(?i(V))] catch throw:not_a_fate_value -> to_scode1(Env, T) end. -to_scode1(Env, {lit, L}) -> - [push(?i(lit_to_fate(Env, L)))]; +to_scode1(Env, {lit, Ann, L}) -> + [ dbg_loc(Env, Ann), push(?i(lit_to_fate(Env, L))) ]; -to_scode1(_Env, nil) -> - [aeb_fate_ops:nil(?a)]; +to_scode1(Env, {nil, Ann}) -> + [ dbg_loc(Env, Ann), aeb_fate_ops:nil(?a) ]; -to_scode1(Env, {var, X}) -> - [push(lookup_var(Env, X))]; +to_scode1(Env, {var, Ann, X}) -> + [ dbg_loc(Env, Ann), push(lookup_var(Env, X)) ]; -to_scode1(Env, {con, Ar, I, As}) -> +to_scode1(Env, {con, Ann, Ar, I, As}) -> N = length(As), - [[to_scode(notail(Env), A) || A <- As], - aeb_fate_ops:variant(?a, ?i(Ar), ?i(I), ?i(N))]; + [ dbg_loc(Env, Ann), + [to_scode(notail(Env), A) || A <- As], + aeb_fate_ops:variant(?a, ?i(Ar), ?i(I), ?i(N)) ]; -to_scode1(Env, {tuple, As}) -> +to_scode1(Env, {tuple, Ann, As}) -> N = length(As), - [[ to_scode(notail(Env), A) || A <- As ], - tuple(N)]; + [ dbg_loc(Env, Ann), + [ to_scode(notail(Env), A) || A <- As ], + tuple(N) ]; -to_scode1(Env, {proj, E, I}) -> - [to_scode(notail(Env), E), - aeb_fate_ops:element_op(?a, ?i(I), ?a)]; +to_scode1(Env, {proj, Ann, E, I}) -> + [ dbg_loc(Env, Ann), + to_scode(notail(Env), E), + aeb_fate_ops:element_op(?a, ?i(I), ?a) ]; -to_scode1(Env, {set_proj, R, I, E}) -> - [to_scode(notail(Env), E), - to_scode(notail(Env), R), - aeb_fate_ops:setelement(?a, ?i(I), ?a, ?a)]; +to_scode1(Env, {set_proj, Ann, R, I, E}) -> + [ dbg_loc(Env, Ann), + to_scode(notail(Env), E), + to_scode(notail(Env), R), + aeb_fate_ops:setelement(?a, ?i(I), ?a, ?a) ]; -to_scode1(Env, {op, Op, Args}) -> - call_to_scode(Env, op_to_scode(Op), Args); +to_scode1(Env, {op, Ann, Op, Args}) -> + [ dbg_loc(Env, Ann) | call_to_scode(Env, op_to_scode(Op), Args) ]; -to_scode1(Env, {'let', X, {var, Y}, Body}) -> +to_scode1(Env, {'let', Ann, X, {var, _, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), - to_scode(Env1, Body); -to_scode1(Env, {'let', X, Expr, Body}) -> + [ dbg_loc(Env, Ann) | dbg_scoped_vars(Env1, [X], to_scode(Env1, Body)) ]; +to_scode1(Env, {'let', Ann, X, Expr, Body}) -> {I, Env1} = bind_local(X, Env), - [ to_scode(notail(Env), Expr), - aeb_fate_ops:store({var, I}, {stack, 0}), - to_scode(Env1, Body) ]; + SCode = [ to_scode(notail(Env), Expr), + aeb_fate_ops:store({var, I}, {stack, 0}), + to_scode(Env1, Body) ], + [ dbg_loc(Env, Ann) | dbg_scoped_vars(Env1, [X], SCode) ]; -to_scode1(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) -> +to_scode1(Env = #env{ current_function = Fun, tailpos = true, debug_info = false }, {def, Ann, Fun, Args}) -> %% Tail-call to current function, f(e0..en). Compile to %% [ let xi = ei ] %% [ STORE argi xi ] @@ -371,61 +355,62 @@ to_scode1(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args} aeb_fate_ops:store({var, I}, ?a)], {[I | Is], Acc1, Env2} end, {[], [], Env}, Args), - [ Code, + [ dbg_loc(Env, Ann), + Code, [ aeb_fate_ops:store({arg, I}, {var, J}) || {I, J} <- lists:zip(lists:seq(0, length(Vars) - 1), lists:reverse(Vars)) ], loop ]; -to_scode1(Env, {def, Fun, Args}) -> +to_scode1(Env, {def, Ann, Fun, Args}) -> FName = make_function_id(Fun), Lbl = aeb_fate_data:make_string(FName), - call_to_scode(Env, local_call(Env, ?i(Lbl)), Args); -to_scode1(Env, {funcall, Fun, Args}) -> - call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args); + [ dbg_loc(Env, Ann) | call_to_scode(Env, local_call(Env, ?i(Lbl)), Args) ]; +to_scode1(Env, {funcall, Ann, Fun, Args}) -> + [ dbg_loc(Env, Ann) | call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args) ]; -to_scode1(Env, {builtin, B, Args}) -> - builtin_to_scode(Env, B, Args); +to_scode1(Env, {builtin, Ann, B, Args}) -> + [ dbg_loc(Env, Ann) | builtin_to_scode(Env, B, Args) ]; -to_scode1(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value, Protected | Args]}) -> +to_scode1(Env, {remote, Ann, ArgsT, RetT, Ct, Fun, [Gas, Value, Protected | Args]}) -> Lbl = make_function_id(Fun), {ArgTypes, RetType0} = typesig_to_scode([{"_", T} || T <- ArgsT], RetT), ArgType = ?i(aeb_fate_data:make_typerep({tuple, ArgTypes})), RetType = ?i(aeb_fate_data:make_typerep(RetType0)), - case Protected of - {lit, {bool, false}} -> + SCode = case Protected of + {lit, _, {bool, false}} -> case Gas of - {builtin, call_gas_left, _} -> + {builtin, _, call_gas_left, _} -> Call = aeb_fate_ops:call_r(?a, Lbl, ArgType, RetType, ?a), call_to_scode(Env, Call, [Ct, Value | Args]); _ -> Call = aeb_fate_ops:call_gr(?a, Lbl, ArgType, RetType, ?a, ?a), call_to_scode(Env, Call, [Ct, Value, Gas | Args]) end; - {lit, {bool, true}} -> + {lit, _, {bool, true}} -> Call = aeb_fate_ops:call_pgr(?a, Lbl, ArgType, RetType, ?a, ?a, ?i(true)), call_to_scode(Env, Call, [Ct, Value, Gas | Args]); _ -> Call = aeb_fate_ops:call_pgr(?a, Lbl, ArgType, RetType, ?a, ?a, ?a), call_to_scode(Env, Call, [Ct, Value, Gas, Protected | Args]) - end; + end, + [ dbg_loc(Env, Ann) | SCode ]; -to_scode1(_Env, {get_state, Reg}) -> - [push(?s(Reg))]; -to_scode1(Env, {set_state, Reg, Val}) -> - call_to_scode(Env, [{'STORE', ?s(Reg), ?a}, - tuple(0)], [Val]); +to_scode1(Env, {get_state, Ann, Reg}) -> + [ dbg_loc(Env, Ann), push(?s(Reg)) ]; +to_scode1(Env, {set_state, Ann, Reg, Val}) -> + [ dbg_loc(Env, Ann) | call_to_scode(Env, [{'STORE', ?s(Reg), ?a}, tuple(0)], [Val]) ]; -to_scode1(Env, {closure, Fun, FVs}) -> - to_scode(Env, {tuple, [{lit, {string, make_function_id(Fun)}}, FVs]}); +to_scode1(Env, {closure, Ann, Fun, FVs}) -> + [ to_scode(Env, {tuple, Ann, [{lit, Ann, {string, make_function_id(Fun)}}, FVs]}) ]; -to_scode1(Env, {switch, Case}) -> - split_to_scode(Env, Case). +to_scode1(Env, {switch, Ann, Case}) -> + [ dbg_loc(Env, Ann) | split_to_scode(Env, Case) ]. -local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun); -local_call(_Env, Fun) -> aeb_fate_ops:call(Fun). +local_call( Env = #env{debug_info = false}, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun); +local_call(_Env, Fun) -> aeb_fate_ops:call(Fun). -split_to_scode(Env, {nosplit, Expr}) -> - [switch_body, to_scode(Env, Expr)]; +split_to_scode(Env, {nosplit, Renames, Expr}) -> + [switch_body, dbg_scoped_vars(Env, Renames, to_scode(Env, Expr))]; split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), Arg = lookup_var(Env, X), @@ -649,7 +634,7 @@ builtin_to_scode(Env, chain_bytecode_hash, [_Addr] = Args) -> builtin_to_scode(Env, chain_clone, [InitArgsT, GasCap, Value, Prot, Contract | InitArgs]) -> case GasCap of - {builtin, call_gas_left, _} -> + {builtin, _, call_gas_left, _} -> call_to_scode(Env, aeb_fate_ops:clone(?a, ?a, ?a, ?a), [Contract, InitArgsT, Value, Prot | InitArgs] ); @@ -682,6 +667,12 @@ op_to_scode('>=') -> aeb_fate_ops:egt(?a, ?a, ?a); op_to_scode('==') -> aeb_fate_ops:eq(?a, ?a, ?a); op_to_scode('!=') -> aeb_fate_ops:neq(?a, ?a, ?a); op_to_scode('!') -> aeb_fate_ops:not_op(?a, ?a); +op_to_scode('bnot') -> aeb_fate_ops:bin_not(?a, ?a); +op_to_scode('band') -> aeb_fate_ops:bin_and(?a, ?a, ?a); +op_to_scode('bor') -> aeb_fate_ops:bin_or(?a, ?a, ?a); +op_to_scode('bxor') -> aeb_fate_ops:bin_xor(?a, ?a, ?a); +op_to_scode('<<') -> aeb_fate_ops:bin_sl(?a, ?a, ?a); +op_to_scode('>>') -> aeb_fate_ops:bin_sr(?a, ?a, ?a); op_to_scode(map_get) -> aeb_fate_ops:map_lookup(?a, ?a, ?a); op_to_scode(map_get_d) -> aeb_fate_ops:map_lookup(?a, ?a, ?a, ?a); op_to_scode(map_set) -> aeb_fate_ops:map_update(?a, ?a, ?a, ?a); @@ -706,7 +697,9 @@ op_to_scode(bits_intersection) -> aeb_fate_ops:bits_and(?a, ?a, ?a); op_to_scode(bits_union) -> aeb_fate_ops:bits_or(?a, ?a, ?a); op_to_scode(bits_difference) -> aeb_fate_ops:bits_diff(?a, ?a, ?a); op_to_scode(address_to_str) -> aeb_fate_ops:addr_to_str(?a, ?a); +op_to_scode(address_to_bytes) -> aeb_fate_ops:addr_to_bytes(?a, ?a); op_to_scode(int_to_str) -> aeb_fate_ops:int_to_str(?a, ?a); +op_to_scode(int_mulmod) -> aeb_fate_ops:mulmod(?a, ?a, ?a, ?a); op_to_scode(contract_to_address) -> aeb_fate_ops:contract_to_address(?a, ?a); op_to_scode(address_to_contract) -> aeb_fate_ops:address_to_contract(?a, ?a); op_to_scode(crypto_verify_sig) -> aeb_fate_ops:verify_sig(?a, ?a, ?a, ?a); @@ -716,6 +709,7 @@ op_to_scode(crypto_ecrecover_secp256k1) -> aeb_fate_ops:ecrecover_secp256k1(?a, op_to_scode(crypto_sha3) -> aeb_fate_ops:sha3(?a, ?a); op_to_scode(crypto_sha256) -> aeb_fate_ops:sha256(?a, ?a); op_to_scode(crypto_blake2b) -> aeb_fate_ops:blake2b(?a, ?a); +op_to_scode(crypto_poseidon) -> aeb_fate_ops:poseidon(?a, ?a, ?a); op_to_scode(stringinternal_sha3) -> aeb_fate_ops:sha3(?a, ?a); op_to_scode(stringinternal_sha256) -> aeb_fate_ops:sha256(?a, ?a); op_to_scode(stringinternal_blake2b) -> aeb_fate_ops:blake2b(?a, ?a); @@ -751,6 +745,77 @@ push(A) -> {'STORE', ?a, A}. tuple(0) -> push(?i({tuple, {}})); tuple(N) -> aeb_fate_ops:tuple(?a, N). +%% -- Debug info functions -- + +dbg_contract(#env{debug_info = false}) -> + []; +dbg_contract(#env{contract = Contract}) -> + [{'DBG_CONTRACT', {immediate, Contract}}]. + +dbg_loc(#env{debug_info = false}, _) -> + []; +dbg_loc(_Env, Ann) -> + File = case proplists:get_value(file, Ann, no_file) of + no_file -> ""; + F -> F + end, + Line = proplists:get_value(line, Ann, undefined), + case Line of + undefined -> []; + _ -> [{'DBG_LOC', {immediate, File}, {immediate, Line}}] + end. + +dbg_scoped_vars(#env{debug_info = false}, _, SCode) -> + SCode; +dbg_scoped_vars(_Env, [], SCode) -> + SCode; +dbg_scoped_vars(Env, [{SavedVarName, Var} | Rest], SCode) -> + dbg_scoped_vars(Env, Rest, dbg_scoped_var(Env, SavedVarName, Var, SCode)); +dbg_scoped_vars(Env = #env{saved_fresh_names = SavedFreshNames}, [Var | Rest], SCode) -> + SavedVarName = maps:get(Var, SavedFreshNames, Var), + dbg_scoped_vars(Env, Rest, dbg_scoped_var(Env, SavedVarName, Var, SCode)). + +dbg_scoped_var(Env, SavedVarName, Var, SCode) -> + case SavedVarName == "_" orelse is_fresh_name(SavedVarName) of + true -> + SCode; + false -> + Register = lookup_var(Env, Var), + Def = [{'DBG_DEF', {immediate, SavedVarName}, Register}], + Undef = [{'DBG_UNDEF', {immediate, SavedVarName}, Register}], + Def ++ dbg_undef(Undef, SCode) + end. + +is_fresh_name([$% | _]) -> + true; +is_fresh_name(_) -> + false. + +dbg_undef(_Undef, missing) -> + missing; +dbg_undef(Undef, loop) -> + [Undef, loop]; +dbg_undef(Undef, switch_body) -> + [switch_body, Undef]; +dbg_undef(Undef, {switch, Arg, Type, Alts, Catch}) -> + NewAlts = [ dbg_undef(Undef, Alt) || Alt <- Alts ], + NewCatch = dbg_undef(Undef, Catch), + NewSwitch = {switch, Arg, Type, NewAlts, NewCatch}, + NewSwitch; +dbg_undef(Undef, SCode) when is_list(SCode) -> + lists:droplast(SCode) ++ [dbg_undef(Undef, lists:last(SCode))]; +dbg_undef(Undef, SCode) when is_tuple(SCode); is_atom(SCode) -> + [Mnemonic | _] = + case is_tuple(SCode) of + true -> tuple_to_list(SCode); + false -> [SCode] + end, + Op = aeb_fate_opcodes:m_to_op(Mnemonic), + case aeb_fate_opcodes:end_bb(Op) of + true -> [Undef, SCode]; + false -> [SCode, Undef] + end. + %% -- Phase II --------------------------------------------------------------- %% Optimize @@ -886,6 +951,10 @@ attributes(I) -> loop -> Impure(pc, []); switch_body -> Pure(none, []); 'RETURN' -> Impure(pc, []); + {'DBG_LOC', _, _} -> Impure(none, []); + {'DBG_DEF', _, _} -> Impure(none, []); + {'DBG_UNDEF', _, _} -> Impure(none, []); + {'DBG_CONTRACT', _} -> Impure(none, []); {'RETURNR', A} -> Impure(pc, A); {'CALL', A} -> Impure(?a, [A]); {'CALL_R', A, _, B, C, D} -> Impure(?a, [A, B, C, D]); @@ -913,6 +982,13 @@ attributes(I) -> {'DIV', A, B, C} -> Pure(A, [B, C]); {'MOD', A, B, C} -> Pure(A, [B, C]); {'POW', A, B, C} -> Pure(A, [B, C]); + {'MULMOD', A, B, C, D} -> Pure(A, [B, C, D]); + {'BAND', A, B, C} -> Pure(A, [B, C]); + {'BOR', A, B, C} -> Pure(A, [B, C]); + {'BXOR', A, B, C} -> Pure(A, [B, C]); + {'BNOT', A, B} -> Pure(A, [B]); + {'BSL', A, B, C} -> Pure(A, [B, C]); + {'BSR', A, B, C} -> Pure(A, [B, C]); {'LT', A, B, C} -> Pure(A, [B, C]); {'GT', A, B, C} -> Pure(A, [B, C]); {'EQ', A, B, C} -> Pure(A, [B, C]); @@ -965,12 +1041,14 @@ attributes(I) -> {'SHA3', A, B} -> Pure(A, [B]); {'SHA256', A, B} -> Pure(A, [B]); {'BLAKE2B', A, B} -> Pure(A, [B]); + {'POSEIDON', A, B, C} -> Pure(A, [B, C]); {'VERIFY_SIG', A, B, C, D} -> Pure(A, [B, C, D]); {'VERIFY_SIG_SECP256K1', A, B, C, D} -> Pure(A, [B, C, D]); {'ECVERIFY_SECP256K1', A, B, C, D} -> Pure(A, [B, C, D]); {'ECRECOVER_SECP256K1', A, B, C} -> Pure(A, [B, C]); {'CONTRACT_TO_ADDRESS', A, B} -> Pure(A, [B]); {'ADDRESS_TO_CONTRACT', A, B} -> Pure(A, [B]); + {'ADDRESS_TO_BYTES', A, B} -> Pure(A, [B]); {'AUTH_TX_HASH', A} -> Pure(A, []); {'AUTH_TX', A} -> Pure(A, []); {'BYTES_TO_INT', A, B} -> Pure(A, [B]); @@ -1605,7 +1683,23 @@ bb(_Name, Code) -> Blocks = lists:flatmap(fun split_calls/1, Blocks1), Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]), BBs = [ set_labels(Labels, B) || B <- Blocks ], - maps:from_list(BBs). + maps:from_list(dbg_loc_filter(BBs)). + +%% Filter DBG_LOC instructions to keep one instruction per line +dbg_loc_filter(BBs) -> + dbg_loc_filter(BBs, [], [], sets:new()). + +dbg_loc_filter([], _, AllBlocks, _) -> + lists:reverse(AllBlocks); +dbg_loc_filter([{I, []} | Rest], AllOps, AllBlocks, DbgLocs) -> + dbg_loc_filter(Rest, [], [{I, lists:reverse(AllOps)} | AllBlocks], DbgLocs); +dbg_loc_filter([{I, [Op = {'DBG_LOC', _, _} | Ops]} | Rest], AllOps, AllBlocks, DbgLocs) -> + case sets:is_element(Op, DbgLocs) of + true -> dbg_loc_filter([{I, Ops} | Rest], AllOps, AllBlocks, DbgLocs); + false -> dbg_loc_filter([{I, Ops} | Rest], [Op | AllOps], AllBlocks, sets:add_element(Op, DbgLocs)) + end; +dbg_loc_filter([{I, [Op | Ops]} | Rest], AllOps, AllBlocks, DbgLocs) -> + dbg_loc_filter([{I, Ops} | Rest], [Op | AllOps], AllBlocks, DbgLocs). %% -- Break up scode into basic blocks -- diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index f844942..c89f1bd 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -333,14 +333,19 @@ expr100() -> expr150() -> infixl(expr200(), binop('|>')). expr200() -> infixr(expr300(), binop('||')). -expr300() -> infixr(expr400(), binop('&&')). +expr300() -> infixr(expr325(), binop('&&')). +expr325() -> infixl(expr350(), binop('bor')). +expr350() -> infixl(expr375(), binop('bxor')). +expr375() -> infixl(expr400(), binop('band')). expr400() -> infix(expr500(), binop(['<', '>', '=<', '>=', '==', '!='])). -expr500() -> infixr(expr600(), binop(['::', '++'])). +expr500() -> infixr(expr550(), binop(['::', '++'])). +expr550() -> infixl(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('!')), expr900(), prefixes(_1, _2)). +expr800() -> ?RULE(many(token('!')), expr850(), prefixes(_1, _2)). +expr850() -> ?RULE(many(token('bnot')), expr900(), prefixes(_1, _2)). expr900() -> ?RULE(exprAtom(), many(elim()), elim(_1, _2)). exprAtom() -> @@ -359,9 +364,12 @@ exprAtom() -> , ?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() diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index afce62c..3ef3300 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -436,15 +436,20 @@ 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, 400, 300}; +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('<') -> {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, 600, 500}; -bin_prec('::') -> {500, 600, 500}; +bin_prec('++') -> {500, 550, 500}; +bin_prec('::') -> {500, 550, 500}; +bin_prec('<<') -> {550, 600, 550}; +bin_prec('>>') -> {550, 600, 550}; bin_prec('+') -> {600, 600, 650}; bin_prec('-') -> {600, 600, 650}; bin_prec('*') -> {700, 700, 750}; @@ -454,7 +459,8 @@ bin_prec('^') -> {750, 750, 800}. -spec un_prec(aeso_syntax:un_op()) -> {integer(), integer()}. un_prec('-') -> {650, 650}; -un_prec('!') -> {800, 800}. +un_prec('!') -> {800, 800}; +un_prec('bnot') -> {850, 850}. equals(Ann, A, B) -> {app, [{format, infix} | Ann], {'=', Ann}, [A, B]}. diff --git a/src/aeso_scan.erl b/src/aeso_scan.erl index 4587efa..a6746bc 100644 --- a/src/aeso_scan.erl +++ b/src/aeso_scan.erl @@ -45,7 +45,7 @@ lexer() -> 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" + "interface", "main", "using", "as", "for", "hiding", "band", "bor", "bxor", "bnot" ], KW = string:join(Keywords, "|"), diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index f1c7f99..1e8ee2d 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -10,7 +10,7 @@ -export([get_ann/1, get_ann/2, get_ann/3, set_ann/2, qualify/2]). --export_type([ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]). +-export_type([ann_file/0, 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]). @@ -24,8 +24,9 @@ -type ann_col() :: integer(). -type ann_origin() :: system | user. -type ann_format() :: '?:' | hex | infix | prefix | elif. +-type ann_file() :: string() | no_file. --type ann() :: [ {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()} +-type ann() :: [ {file, ann_file()} | {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()} | stateful | private | payable | main | interface | entrypoint]. -type name() :: string(). @@ -106,8 +107,8 @@ -type bin_op() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | '<' | '>' | '=<' | '>=' | '==' | '!=' - | '||' | '&&' | '..' | '|>'. --type un_op() :: '-' | '!'. + | '||' | '&&' | '..' | 'band' | 'bor' | 'bxor' | '>>' | '<<' | '|>'. +-type un_op() :: '-' | '!' | 'bnot'. -type expr() :: {lam, ann(), [arg()], expr()} diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index e50f2d4..c9ee23a 100644 --- a/src/aeso_syntax_utils.erl +++ b/src/aeso_syntax_utils.erl @@ -31,11 +31,13 @@ | 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, type, T) end, - Expr = fun(E) -> fold(Alg, Fun, expr, E) end, + Type = fun(T) -> fold(Alg, Fun, TypeKind, T) end, + Expr = fun(E) -> fold(Alg, Fun, ExprKind, 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), @@ -155,4 +157,3 @@ used(D) -> (_, _) -> #{} end, decl, D)), lists:filter(NotBound, Xs). - diff --git a/src/aeso_vm_decode.erl b/src/aeso_vm_decode.erl index dc5d18b..e1941b8 100644 --- a/src/aeso_vm_decode.erl +++ b/src/aeso_vm_decode.erl @@ -88,7 +88,7 @@ from_fate_builtin(QType, Val) -> {["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)]); + Chk(Map(Str, Qid(["AENS", "pointee"])), Ptrs)]); {["AENS", "pointee"], {variant, [1, 1, 1, 1], 0, {Addr}}} -> App(["AENS","AccountPt"], [Chk(Adr, Addr)]); @@ -99,6 +99,21 @@ from_fate_builtin(QType, Val) -> {["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, {Val}}} -> + App(["AENSv2","AccountPt"], [Chk(Adr, Val)]); + {["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 1, {Val}}} -> + App(["AENSv2","OraclePt"], [Chk(Adr, Val)]); + {["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 2, {Val}}} -> + App(["AENSv2","ContractPt"], [Chk(Adr, Val)]); + {["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 3, {Val}}} -> + App(["AENSv2","ChannelPt"], [Chk(Adr, Val)]); + {["AENSv2", "pointee"], {variant, [1, 1, 1, 1, 1], 4, {Val}}} -> + App(["AENSv2","DataPt"], [Chk(Str, Val)]); + {["Chain", "ga_meta_tx"], {variant, [2], 0, {Addr, X}}} -> App(["Chain","GAMetaTx"], [Chk(Adr, Addr), Chk(Int, X)]); diff --git a/src/aesophia.app.src b/src/aesophia.app.src index 31ff7c2..a483fe3 100644 --- a/src/aesophia.app.src +++ b/src/aesophia.app.src @@ -1,6 +1,6 @@ {application, aesophia, [{description, "Compiler for Aeternity Sophia language"}, - {vsn, "7.0.1"}, + {vsn, "8.0.0"}, {registered, []}, {applications, [kernel, diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 0ca006b..5d2c417 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -69,6 +69,7 @@ simple_compile_test_() -> [ {"Testing warning messages", fun() -> #{ warnings := Warnings } = compile("warnings", [warn_all]), + #{ warnings := [] } = compile("warning_unused_include_no_include", [warn_all]), check_warnings(warnings(), Warnings) end} ] ++ []. @@ -205,6 +206,9 @@ compilable_contracts() -> "polymorphism_variance_switching_chain_create", "polymorphism_variance_switching_void_supertype", "polymorphism_variance_switching_unify_with_interface_decls", + "polymorphism_preserve_or_add_payable_contract", + "polymorphism_preserve_or_add_payable_entrypoint", + "polymorphism_preserve_or_remove_stateful_entrypoint", "missing_init_fun_state_unit", "complex_compare_leq", "complex_compare", @@ -218,6 +222,8 @@ compilable_contracts() -> "unapplied_contract_call", "unapplied_named_arg_builtin", "resolve_field_constraint_by_arity", + "toplevel_constants", + "ceres", "test" % Custom general-purpose test file. Keep it last on the list. ]. @@ -282,7 +288,11 @@ warnings() -> <>, <> + "The function `dec` is defined but never used.">>, + <>, + <> ]). failing_contracts() -> @@ -654,10 +664,6 @@ failing_contracts() -> [<>]) - , ?TYPE_ERROR(toplevel_let, - [<>]) , ?TYPE_ERROR(empty_typedecl, [< <>, <> + "The function `dec` is defined but never used.">>, + <>, + <> ]) , ?TYPE_ERROR(polymorphism_contract_interface_recursive, [< " - line 9, column 5">>]) , ?TYPE_ERROR(polymorphism_contract_missing_implementation, [<> + "Unimplemented entrypoint `f` from the interface `I1` in the contract `I2`">> ]) , ?TYPE_ERROR(polymorphism_contract_same_decl_multi_interface, [< ]) , ?TYPE_ERROR(polymorphic_aens_resolve, [<> ]) , ?TYPE_ERROR(bad_aens_resolve, [<> ]) , ?TYPE_ERROR(bad_aens_resolve_using, [<> ]) @@ -1152,6 +1162,111 @@ failing_contracts() -> "to arguments\n" " `Chain.create : (value : int, var_args) => 'c`">> ]) + , ?TYPE_ERROR(polymorphism_add_stateful_entrypoint, + [<> + ]) + , ?TYPE_ERROR(polymorphism_change_entrypoint_to_function, + [<> + ]) + , ?TYPE_ERROR(polymorphism_non_payable_contract_implement_payable, + [<> + ]) + , ?TYPE_ERROR(polymorphism_non_payable_interface_implement_payable, + [<> + ]) + , ?TYPE_ERROR(polymorphism_remove_payable_entrypoint, + [<> + ]) + , ?TYPE_ERROR(calling_child_contract_entrypoint, + [<>]) + , ?TYPE_ERROR(using_contract_as_namespace, + [<>]) + , ?TYPE_ERROR(hole_expression, + [<>, + <>, + < int`">>, + <> + ]) + , ?TYPE_ERROR(toplevel_constants_contract_as_namespace, + [<>, + <>, + <>, + <>, + <> + ]) + , ?TYPE_ERROR(toplevel_constants_cycles, + [<>, + <> + ]) + , ?TYPE_ERROR(toplevel_constants_in_interface, + [<>, + <>, + <> + ]) + , ?TYPE_ERROR(toplevel_constants_invalid_expr, + [<>, + <>, + <>, + <>, + <>, + <>, + <>, + <>, + <>, + <> + ]) + , ?TYPE_ERROR(toplevel_constants_invalid_id, + [<>, + <> + ]) ]. validation_test_() -> diff --git a/test/aeso_parser_tests.erl b/test/aeso_parser_tests.erl index e3b7598..2324fc4 100644 --- a/test/aeso_parser_tests.erl +++ b/test/aeso_parser_tests.erl @@ -53,7 +53,7 @@ simple_contracts_test_() -> %% associativity [ RightAssoc(Op) || Op <- ["||", "&&", "::", "++"] ], [ NonAssoc(Op) || Op <- ["==", "!=", "<", ">", "=<", ">="] ], - [ LeftAssoc(Op) || Op <- ["+", "-", "*", "/", "mod"] ], + [ LeftAssoc(Op) || Op <- ["+", "-", "*", "/", "mod", "band", "bor", "bxor", "<<", ">>"] ], %% precedence [ Stronger(Op2, Op1) || [T1 , T2 | _] <- tails(Tiers), Op1 <- T1, Op2 <- T2 ], diff --git a/test/aeso_scan_tests.erl b/test/aeso_scan_tests.erl index 685d3ac..92912e0 100644 --- a/test/aeso_scan_tests.erl +++ b/test/aeso_scan_tests.erl @@ -39,7 +39,8 @@ all_tokens() -> %% Symbols lists:map(Lit, [',', '.', ';', '|', ':', '(', ')', '[', ']', '{', '}']) ++ %% Operators - lists:map(Lit, ['=', '==', '!=', '>', '<', '>=', '=<', '-', '+', '++', '*', '/', mod, ':', '::', '->', '=>', '||', '&&', '!']) ++ + lists:map(Lit, ['=', '==', '!=', '>', '<', '>=', '=<', '-', '+', '++', '*', '/', mod, + ':', '::', '->', '=>', '||', '&&', '!', 'band', 'bor', 'bxor', 'bnot' ,'<<', '>>']) ++ %% Keywords lists:map(Lit, [contract, type, 'let', switch]) ++ %% Comment token (not an actual token), just for tests diff --git a/test/contracts/aens.aes b/test/contracts/aens.aes index 698e4c5..ac59b4d 100644 --- a/test/contracts/aens.aes +++ b/test/contracts/aens.aes @@ -6,77 +6,77 @@ main contract AENSTest = // Name resolution stateful entrypoint resolve_word(name : string, key : string) : option(address) = - AENS.resolve(name, key) + AENSv2.resolve(name, key) stateful entrypoint resolve_string(name : string, key : string) : option(string) = - AENS.resolve(name, key) + AENSv2.resolve(name, key) stateful entrypoint resolve_contract(name : string, key : string) : option(C) = - AENS.resolve(name, key) + AENSv2.resolve(name, key) stateful entrypoint resolve_oracle(name : string, key : string) : option(oracle(int, int)) = - AENS.resolve(name, key) + AENSv2.resolve(name, key) stateful entrypoint resolve_oracle_query(name : string, key : string) : option(oracle_query(int, int)) = - AENS.resolve(name, key) + AENSv2.resolve(name, key) // Transactions stateful entrypoint preclaim(addr : address, // Claim on behalf of this account (can be Contract.address) chash : hash) : unit = // Commitment hash - AENS.preclaim(addr, chash) + AENSv2.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) - AENS.preclaim(addr, chash, signature = sign) + AENSv2.preclaim(addr, chash, signature = sign) stateful entrypoint claim(addr : address, name : string, salt : int, name_fee : int) : unit = - AENS.claim(addr, name, salt, name_fee) + AENSv2.claim(addr, name, salt, name_fee) stateful entrypoint signedClaim(addr : address, name : string, salt : int, name_fee : int, sign : signature) : unit = - AENS.claim(addr, name, salt, name_fee, signature = sign) + 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, AENS.pointee))) : unit = - AENS.update(owner, name, ttl, client_ttl, pointers) + 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, AENS.pointee)), + pointers : option(map(string, AENSv2.pointee)), sign : signature) : unit = - AENS.update(owner, name, ttl, client_ttl, pointers, signature = sign) + AENSv2.update(owner, name, ttl, client_ttl, pointers, signature = sign) stateful entrypoint transfer(owner : address, new_owner : address, name : string) : unit = - AENS.transfer(owner, new_owner, name) + AENSv2.transfer(owner, new_owner, name) stateful entrypoint signedTransfer(owner : address, new_owner : address, name : string, sign : signature) : unit = - AENS.transfer(owner, new_owner, name, signature = sign) + AENSv2.transfer(owner, new_owner, name, signature = sign) stateful entrypoint revoke(owner : address, name : string) : unit = - AENS.revoke(owner, name) + AENSv2.revoke(owner, name) stateful entrypoint signedRevoke(owner : address, name : string, sign : signature) : unit = - AENS.revoke(owner, name, signature = sign) + AENSv2.revoke(owner, name, signature = sign) diff --git a/test/contracts/aens_update.aes b/test/contracts/aens_update.aes index 5d65229..3b8fc7c 100644 --- a/test/contracts/aens_update.aes +++ b/test/contracts/aens_update.aes @@ -1,17 +1,30 @@ -contract AENSUpdate = +include "Option.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) = - let p1 : AENS.pointee = AENS.AccountPt(Call.caller) - let p2 : AENS.pointee = AENS.OraclePt(Call.caller) - let p3 : AENS.pointee = AENS.ContractPt(Call.caller) - let p4 : AENS.pointee = AENS.ChannelPt(Call.caller) - AENS.update(owner, name, None, None, - Some({ ["account_pubkey"] = p1, ["oracle_pubkey"] = p2, - ["contract_pubkey"] = p3, ["misc"] = p4 })) + 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("any something will do") + AENSv2.update(owner, name, None, None, + Some({ ["account_pubkey"] = p1, ["oracle_pubkey"] = p2, + ["contract_pubkey"] = p3, ["misc"] = p4, ["data"] = p5 })) + + 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(AENS.lookup(name)) - Some(AENS.Name(_, FixedTTL(ttl), _)) => ttl + switch(AENSv2.lookup(name)) + Some(AENSv2.Name(_, FixedTTL(ttl), _)) => ttl entrypoint expiry(o : oracle(int, int)) : int = Oracle.expiry(o) - diff --git a/test/contracts/all_syntax.aes b/test/contracts/all_syntax.aes index 513f3be..823de77 100644 --- a/test/contracts/all_syntax.aes +++ b/test/contracts/all_syntax.aes @@ -6,6 +6,7 @@ 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 @@ -33,6 +34,8 @@ contract AllSyntax = type state = shakespeare(int) + let cc = "str" + entrypoint init() = { johann = 1000, wolfgang = -10, diff --git a/test/contracts/bad_aens_resolve.aes b/test/contracts/bad_aens_resolve.aes index 8700dfb..44f15e5 100644 --- a/test/contracts/bad_aens_resolve.aes +++ b/test/contracts/bad_aens_resolve.aes @@ -3,7 +3,7 @@ contract BadAENSresolve = type t('a) = option(list('a)) function fail() : t(int) = - AENS.resolve("foo.aet", "whatever") + AENSv2.resolve("foo.aet", "whatever") entrypoint main_fun() = () diff --git a/test/contracts/bad_aens_resolve_using.aes b/test/contracts/bad_aens_resolve_using.aes index 8556f46..5b367e7 100644 --- a/test/contracts/bad_aens_resolve_using.aes +++ b/test/contracts/bad_aens_resolve_using.aes @@ -1,9 +1,9 @@ contract BadAENSresolve = - using AENS + using AENSv2 type t('a) = option(list('a)) function fail() : t(int) = resolve("foo.aet", "whatever") - entrypoint main_fun() = () \ No newline at end of file + entrypoint main_fun() = () diff --git a/test/contracts/calling_child_contract_entrypoint.aes b/test/contracts/calling_child_contract_entrypoint.aes new file mode 100644 index 0000000..3e9f4c0 --- /dev/null +++ b/test/contracts/calling_child_contract_entrypoint.aes @@ -0,0 +1,5 @@ +contract F = + entrypoint g() = 1 + +main contract C = + entrypoint f() = F.g() diff --git a/test/contracts/ceres.aes b/test/contracts/ceres.aes new file mode 100644 index 0000000..832334f --- /dev/null +++ b/test/contracts/ceres.aes @@ -0,0 +1,14 @@ +contract C = + entrypoint test() = + let a : int = 23 + let b : int = 52 + let c = a bor b + let d = c bxor b + let e = d band b + let f = bnot a + let g = f << 2 + let h = g >> 2 + let i = Int.mulmod(a, b, h) + let j = Crypto.poseidon(i, a) + let k : bytes(32) = Address.to_bytes(Call.origin) + (a bor b band c bxor a << bnot b >> a, k) diff --git a/test/contracts/hole_expression.aes b/test/contracts/hole_expression.aes new file mode 100644 index 0000000..99594d8 --- /dev/null +++ b/test/contracts/hole_expression.aes @@ -0,0 +1,13 @@ +include "List.aes" + +contract C = + entrypoint f() = + let ??? = true + let v = ??? + let q = v == "str" + let xs = [1, 2, 3, 4] + switch (List.first(List.map(???, xs))) + Some(x) => x + 1 + None => 0 + + function g() = ??? diff --git a/test/contracts/polymorphic_aens_resolve.aes b/test/contracts/polymorphic_aens_resolve.aes index 0bd9cc8..15517dd 100644 --- a/test/contracts/polymorphic_aens_resolve.aes +++ b/test/contracts/polymorphic_aens_resolve.aes @@ -1,7 +1,7 @@ contract PolymorphicAENSresolve = function fail() : option('a) = - AENS.resolve("foo.aet", "whatever") + AENSv2.resolve("foo.aet", "whatever") entrypoint main_fun() = () diff --git a/test/contracts/polymorphism_add_stateful_entrypoint.aes b/test/contracts/polymorphism_add_stateful_entrypoint.aes new file mode 100644 index 0000000..26b279c --- /dev/null +++ b/test/contracts/polymorphism_add_stateful_entrypoint.aes @@ -0,0 +1,5 @@ +contract interface I = + entrypoint f : () => int + +contract C : I = + stateful entrypoint f() = 1 diff --git a/test/contracts/polymorphism_change_entrypoint_to_function.aes b/test/contracts/polymorphism_change_entrypoint_to_function.aes new file mode 100644 index 0000000..38c9614 --- /dev/null +++ b/test/contracts/polymorphism_change_entrypoint_to_function.aes @@ -0,0 +1,6 @@ +contract interface I = + entrypoint f : () => int + +contract C : I = + entrypoint init() = () + function f() = 1 diff --git a/test/contracts/polymorphism_non_payable_contract_implement_payable.aes b/test/contracts/polymorphism_non_payable_contract_implement_payable.aes new file mode 100644 index 0000000..59c0fca --- /dev/null +++ b/test/contracts/polymorphism_non_payable_contract_implement_payable.aes @@ -0,0 +1,5 @@ +payable contract interface I = + payable entrypoint f : () => int + +contract C : I = + entrypoint f() = 123 diff --git a/test/contracts/polymorphism_non_payable_interface_implement_payable.aes b/test/contracts/polymorphism_non_payable_interface_implement_payable.aes new file mode 100644 index 0000000..3849ea5 --- /dev/null +++ b/test/contracts/polymorphism_non_payable_interface_implement_payable.aes @@ -0,0 +1,8 @@ +payable contract interface I = + payable entrypoint f : () => int + +contract interface H : I = + payable entrypoint f : () => int + +payable contract C : H = + entrypoint f() = 123 diff --git a/test/contracts/polymorphism_preserve_or_add_payable_contract.aes b/test/contracts/polymorphism_preserve_or_add_payable_contract.aes new file mode 100644 index 0000000..1d8877c --- /dev/null +++ b/test/contracts/polymorphism_preserve_or_add_payable_contract.aes @@ -0,0 +1,14 @@ +contract interface F = + entrypoint f : () => int + +payable contract interface G : F = + payable entrypoint f : () => int + entrypoint g : () => int + +payable contract interface H = + payable entrypoint h : () => int + +payable contract C : G, H = + payable entrypoint f() = 1 + payable entrypoint g() = 2 + payable entrypoint h() = 3 diff --git a/test/contracts/polymorphism_preserve_or_add_payable_entrypoint.aes b/test/contracts/polymorphism_preserve_or_add_payable_entrypoint.aes new file mode 100644 index 0000000..9940a8b --- /dev/null +++ b/test/contracts/polymorphism_preserve_or_add_payable_entrypoint.aes @@ -0,0 +1,7 @@ +contract interface I = + payable entrypoint f : () => int + entrypoint g : () => int + +contract C : I = + payable entrypoint f() = 1 + payable entrypoint g() = 2 diff --git a/test/contracts/polymorphism_preserve_or_remove_stateful_entrypoint.aes b/test/contracts/polymorphism_preserve_or_remove_stateful_entrypoint.aes new file mode 100644 index 0000000..71a39dc --- /dev/null +++ b/test/contracts/polymorphism_preserve_or_remove_stateful_entrypoint.aes @@ -0,0 +1,7 @@ +contract interface I = + stateful entrypoint f : () => int + stateful entrypoint g : () => int + +contract C : I = + stateful entrypoint f() = 1 + entrypoint g() = 2 diff --git a/test/contracts/polymorphism_remove_payable_entrypoint.aes b/test/contracts/polymorphism_remove_payable_entrypoint.aes new file mode 100644 index 0000000..b916ca1 --- /dev/null +++ b/test/contracts/polymorphism_remove_payable_entrypoint.aes @@ -0,0 +1,5 @@ +contract interface I = + payable entrypoint f : () => int + +contract C : I = + entrypoint f() = 1 diff --git a/test/contracts/toplevel_constants.aes b/test/contracts/toplevel_constants.aes new file mode 100644 index 0000000..86ac9be --- /dev/null +++ b/test/contracts/toplevel_constants.aes @@ -0,0 +1,64 @@ +namespace N0 = + let nsconst = 1 + +namespace N = + let nsconst = N0.nsconst + +contract C = + datatype event = EventX(int, string) + + record account = { name : string, + balance : int } + + let c01 = 2425 + let c02 = -5 + let c03 = ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt + let c04 = true + let c05 = Bits.none + let c06 = #fedcba9876543210 + let c07 = "str" + let c08 = [1, 2, 3] + let c09 = [(true, 24), (false, 19), (false, -42)] + let c10 = (42, "Foo", true) + let c11 = { name = "str", balance = 100000000 } + let c12 = {["foo"] = 19, ["bar"] = 42} + let c13 = Some(42) + let c14 = 11 : int + let c15 = EventX(0, "Hello") + let c16 = #000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f + let c17 = #000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f + let c18 = RelativeTTL(50) + let c19 = ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 + let c20 = oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY + let c21 = ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ : C + let c22 = N.nsconst + let c23 = c01 + let c24 = c11.name + let c25 : int = 1 + + entrypoint f01() = c01 + entrypoint f02() = c02 + entrypoint f03() = c03 + entrypoint f04() = c04 + entrypoint f05() = c05 + entrypoint f06() = c06 + entrypoint f07() = c07 + entrypoint f08() = c08 + entrypoint f09() = c09 + entrypoint f10() = c10 + entrypoint f11() = c11 + entrypoint f12() = c12 + entrypoint f13() = c13 + entrypoint f14() = c14 + entrypoint f15() = c15 + entrypoint f16() = c16 + entrypoint f17() = c17 + entrypoint f18() = c18 + entrypoint f19() = c19 + entrypoint f20() = c20 + entrypoint f21() = c21 + entrypoint f22() = c22 + entrypoint f23() = c23 + entrypoint f24() = c24 + entrypoint f25() = c25 + entrypoint fqual() = C.c01 diff --git a/test/contracts/toplevel_constants_contract_as_namespace.aes b/test/contracts/toplevel_constants_contract_as_namespace.aes new file mode 100644 index 0000000..8bd6432 --- /dev/null +++ b/test/contracts/toplevel_constants_contract_as_namespace.aes @@ -0,0 +1,11 @@ +contract G = + let const = 1 + +main contract C = + let c = G.const + + stateful entrypoint f() = + let g = Chain.create() : G + + g.const + g.const() diff --git a/test/contracts/toplevel_constants_cycles.aes b/test/contracts/toplevel_constants_cycles.aes new file mode 100644 index 0000000..3096125 --- /dev/null +++ b/test/contracts/toplevel_constants_cycles.aes @@ -0,0 +1,6 @@ +contract C = + let selfcycle = selfcycle + + let cycle1 = cycle2 + let cycle2 = cycle3 + let cycle3 = cycle1 diff --git a/test/contracts/toplevel_constants_in_interface.aes b/test/contracts/toplevel_constants_in_interface.aes new file mode 100644 index 0000000..56558a7 --- /dev/null +++ b/test/contracts/toplevel_constants_in_interface.aes @@ -0,0 +1,7 @@ +contract interface I = + let (x::y::_) = [1,2,3] + let c = 10 + let d = 10 + +contract C = + entrypoint init() = () diff --git a/test/contracts/toplevel_constants_invalid_expr.aes b/test/contracts/toplevel_constants_invalid_expr.aes new file mode 100644 index 0000000..c9deecd --- /dev/null +++ b/test/contracts/toplevel_constants_invalid_expr.aes @@ -0,0 +1,21 @@ +main contract C = + record account = { name : string, + balance : int } + + let one = 1 + let opt = Some(5) + let acc = { name = "str", balance = 100000 } + let mpp = {["foo"] = 19, ["bar"] = 42} + + let c01 = [x | x <- [1,2,3,4,5]] + let c02 = [x + k | x <- [1,2,3,4,5], let k = x*x] + let c03 = [x + y | x <- [1,2,3,4,5], let k = x*x, if (k > 5), y <- [k, k+1, k+2]] + let c04 = if (one > 2) 3 else 4 + let c05 = switch (opt) + Some(x) => x + None => 2 + let c07 = acc{ balance = one } + let c08 = mpp["foo"] + let c09 = mpp["non" = 10] + let c10 = mpp{["foo"] = 20} + let c11 = (x) => x + 1 diff --git a/test/contracts/toplevel_constants_invalid_id.aes b/test/contracts/toplevel_constants_invalid_id.aes new file mode 100644 index 0000000..3b1820b --- /dev/null +++ b/test/contracts/toplevel_constants_invalid_id.aes @@ -0,0 +1,3 @@ +contract C = + let x::_ = [1,2,3,4] + let y::(p = z::_) = [1,2,3,4] diff --git a/test/contracts/toplevel_let.aes b/test/contracts/toplevel_let.aes deleted file mode 100644 index adca04c..0000000 --- a/test/contracts/toplevel_let.aes +++ /dev/null @@ -1,3 +0,0 @@ -contract C = - let this_is_illegal = 2/0 - entrypoint this_is_legal() = 2/0 \ No newline at end of file diff --git a/test/contracts/unapplied_builtins.aes b/test/contracts/unapplied_builtins.aes index 169a29b..5a8b340 100644 --- a/test/contracts/unapplied_builtins.aes +++ b/test/contracts/unapplied_builtins.aes @@ -2,10 +2,10 @@ // Named argument builtins are: // Oracle.register // Oracle.respond -// AENS.preclaim -// AENS.claim -// AENS.transfer -// AENS.revoke +// AENSv2.preclaim +// AENSv2.claim +// AENSv2.transfer +// AENSv2.revoke // Oracle.extend include "String.aes" contract UnappliedBuiltins = @@ -28,7 +28,7 @@ contract UnappliedBuiltins = function oracle_get_answer() = Oracle.get_answer : (o, _) => _ function oracle_check() = Oracle.check : o => _ function oracle_check_query() = Oracle.check_query : (o, _) => _ - function aens_resolve() = AENS.resolve : (_, _) => option(string) + function aens_resolve() = AENSv2.resolve : (_, _) => option(string) function map_lookup() = Map.lookup : (_, m) => _ function map_lookup_default() = Map.lookup_default : (_, m, _) => _ function map_member() = Map.member : (_, m) => _ diff --git a/test/contracts/using_contract_as_namespace.aes b/test/contracts/using_contract_as_namespace.aes new file mode 100644 index 0000000..61c1390 --- /dev/null +++ b/test/contracts/using_contract_as_namespace.aes @@ -0,0 +1,7 @@ +contract F = + entrypoint g() = 1 + +main contract C = + using F for [g] + + entrypoint f() = g() \ No newline at end of file diff --git a/test/contracts/warning_unused_include_no_include.aes b/test/contracts/warning_unused_include_no_include.aes new file mode 100644 index 0000000..edf2fd2 --- /dev/null +++ b/test/contracts/warning_unused_include_no_include.aes @@ -0,0 +1,5 @@ +namespace N = + function nconst() = 1 + +main contract C = + entrypoint f() = N.nconst() diff --git a/test/contracts/warnings.aes b/test/contracts/warnings.aes index 5aa05ce..45e763d 100644 --- a/test/contracts/warnings.aes +++ b/test/contracts/warnings.aes @@ -12,7 +12,7 @@ namespace UnusedNamespace = // Unused private function h() = 3 -contract Warnings = +main contract Warnings = type state = int @@ -58,3 +58,31 @@ namespace FunctionsAsArgs = private function inc(n : int) : int = n + 1 // Never used private function dec(n : int) : int = n - 1 + +contract Remote = + entrypoint id(_) = 0 + +contract C = + payable stateful entrypoint + call_missing_con() : int = (ct_1111111111111111111111111111112JF6Dz72 : Remote).id(value = 1, 0) + +namespace ShadowingConst = + let const = 1 + + function f() = + let const = 2 + const + +namespace UnusedConstNamespace = + // No warnings should be shown even though const is not used + let const = 1 + +contract UnusedConstContract = + // Only `c` should show a warning because it is never used in the contract + let a = 1 + let b = 2 + let c = 3 + + entrypoint f() = + // Both normal access and qualified access should prevent the unused const warning + a + UnusedConstContract.b