Remove unexported functions

This reverts commit f835862a48.

.circleci/config.yml

@@ -3,7 +3,7 @@ version: 2.1
 executors:
   aebuilder:
     docker:
-      - image: aeternity/builder:xenial-otp21
+      - image: aeternity/builder:bionic-otp24
         user: builder
     working_directory: ~/aesophia
 

.github/workflows/docs-develop.yml

@@ -13,10 +13,6 @@ jobs:
       - uses: actions/setup-python@v2
         with:
           python-version: 3.8
-      - uses: actions/cache@v2
-        with:
-          path: ~/.cache/pip3
-          key: ${{ runner.os }}-pip-${{ hashFiles('.github/workflows/requirements.txt') }}
       - run: pip3 install -r .github/workflows/requirements.txt -U
       - run: git config --global user.email "github-action@users.noreply.github.com"
       - run: git config --global user.name "GitHub Action"

.github/workflows/docs-release.yml

@@ -13,10 +13,6 @@ jobs:
       - uses: actions/setup-python@v2
         with:
           python-version: 3.8
-      - uses: actions/cache@v2
-        with:
-          path: ~/.cache/pip3
-          key: ${{ runner.os }}-pip-${{ hashFiles('.github/workflows/requirements.txt') }}
       - run: pip3 install -r .github/workflows/requirements.txt -U
       - run: git config --global user.email "github-action@users.noreply.github.com"
       - run: git config --global user.name "GitHub Action"

.github/workflows/requirements.txt

@@ -1,5 +1,5 @@
-mkdocs==1.2.4
-mkdocs-simple-hooks==0.1.3
-mkdocs-material==7.1.9
-mike==1.0.1
-pygments==2.11.2
+mkdocs==1.4.2
+mkdocs-simple-hooks==0.1.5
+mkdocs-material==9.0.9
+mike==1.1.2
+pygments==2.14.0

CHANGELOG.md

@@ -6,7 +6,49 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 ### Added
-- Compiler warnings for the follwing: shadowing, negative spends, division by zero, unused functions, unused includes, unused stateful annotations, unused variables, unused parameters, unused user-defined type, dead return value.
+- Toplevel compile-time constants
+  ```
+  namespace N =
+    let nc = 1
+  contract C =
+    let cc = 2
+  ```
+### Changed
+### Removed
+### Fixed
+- Warning about unused include when there is no include.
+
+## [7.1.0]
+### Added
+- Options to enable/disable certain optimizations.
+- The ability to call a different instance of the current contract
+  ```
+  contract Main =
+    entrypoint spend(x : int) : int = x
+    entrypoint f(c : Main) : int = c.spend(10)
+  ```
+- Return a mapping from variables to FATE registers in the compilation output.
+- Hole expression.
+### Changed
+- Type definitions serialised to ACI as `typedefs` field instead of `type_defs` to increase compatibility.
+- Check contracts and entrypoints modifiers when implementing interfaces.
+- Contracts can no longer be used as namespaces.
+- Do not show unused stateful warning for functions that call other contracts with a non-zero value argument.
+### Fixed
+- Typechecker crashes if Chain.create or Chain.clone are used without arguments.
+
+## [7.0.1]
+### Added
+- Add CONTRIBUTING.md file.
+### Changed
+- Update Sophia syntax docs to include missing information about existing syntax.
+### Fixed
+- [404](https://github.com/aeternity/aesophia/issues/404) Contract polymorphism crashes on non-obvious child contract typing.
+
+## [7.0.0]
+### Added
+- Added support for `EXIT` opcode via `exit : (string) => 'a` function (behaves same as `ABORT`, but consumes all gas).
+- Compiler warnings for the following: shadowing, negative spends, division by zero, unused functions, unused includes, unused stateful annotations, unused variables, unused parameters, unused user-defined type, dead return value.
 - The pipe operator |>
   ```
   [1, 2, 3] |> List.first |> Option.is_some  // Option.is_some(List.first([1, 2, 3]))
@@ -16,6 +58,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
   function sum(l : list(int)) : int = foldl((+), 0, l)
   function logical_and(x, y) = (&&)(x, y)
   ```
+- Contract interfaces polymorphism
 ### Changed
 - Error messages have been restructured (less newlines) to provide more unified errors. Also `pp_oneline/1` has been added.
 - Ban empty record definitions (e.g. `record r = {}` would give an error).
@@ -345,7 +388,10 @@ 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/v6.1.0...HEAD
+[Unreleased]: https://github.com/aeternity/aesophia/compare/v7.1.0...HEAD
+[7.1.0]: https://github.com/aeternity/aesophia/compare/v7.0.1...v7.1.0
+[7.0.1]: https://github.com/aeternity/aesophia/compare/v7.0.0...v7.0.1
+[7.0.0]: https://github.com/aeternity/aesophia/compare/v6.1.0...v7.0.0
 [6.1.0]: https://github.com/aeternity/aesophia/compare/v6.0.2...v6.1.0
 [6.0.2]: https://github.com/aeternity/aesophia/compare/v6.0.1...v6.0.2
 [6.0.1]: https://github.com/aeternity/aesophia/compare/v6.0.0...v6.0.1

CONTRIBUTING.md

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

README.md

@@ -14,6 +14,7 @@ The compiler is currently being used three places
 * [Features](docs/sophia_features.md)
 * [Standard library](docs/sophia_stdlib.md)
 * [Contract examples](docs/sophia_examples.md)
+* [Contributing](CONTRIBUTING.md)
 
 Additionally you can check out the [contracts section](https://github.com/aeternity/protocol/blob/master/contracts/contracts.md) of the æternity blockchain specification.
 

docs/aeso_aci.md

@@ -67,7 +67,7 @@ generates the following JSON structure representing the contract interface:
         }
       ]
     },
-    "type_defs": [
+    "typedefs": [
       {
         "name": "answers",
         "typedef": {
@@ -138,7 +138,7 @@ be included inside another contract.
              state =>
                  #{record =>
                        [#{name => <<"a">>,type => <<"Answers.answers">>}]},
-             type_defs =>
+             typedefs =>
                  [#{name => <<"answers">>,
                     typedef => #{<<"map">> => [<<"string">>,<<"int">>]},
                     vars => []}]}}]}

docs/aeso_compiler.md

@@ -51,6 +51,36 @@ The **pp_** options all print to standard output the following:
 
 `pp_assembler` - print the generated assembler code
 
+The option `include_child_contract_symbols` includes the symbols of child contracts functions in the generated fate code. It is turned off by default to avoid making contracts bigger on chain.
+
+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
+explicitly set to false and passed as a compiler option.
+
+List of optimizations:
+
+- optimize_inliner
+- optimize_inline_local_functions
+- optimize_bind_subexpressions
+- optimize_let_floating
+- optimize_simplifier
+- optimize_drop_unused_lets
+- optimize_push_consume
+- optimize_one_shot_var
+- optimize_write_to_dead_var
+- optimize_inline_switch_target
+- optimize_swap_push
+- optimize_swap_pop
+- optimize_swap_write
+- optimize_constant_propagation
+- optimize_prune_impossible_branches
+- optimize_single_successful_branch
+- optimize_inline_store
+- optimize_float_switch_bod
+
 #### check_call(ContractString, Options) -> CheckRet
 
 Types

docs/sophia_features.md

@@ -134,6 +134,166 @@ main contract IntHolderFactory =
 In case of a presence of child contracts (`IntHolder` in this case), the main
 contract must be pointed out with the `main` keyword as shown in the example.
 
+### Contract interfaces and polymorphism
+
+Contracts can implement one or multiple interfaces, the contract has to define
+every entrypoint from the implemented interface and the entrypoints in both
+the contract and implemented interface should have compatible types.
+
+```
+contract interface Animal =
+  entrypoint sound : () => string
+
+ contract Cat : Animal =
+  entrypoint sound() = "Cat sound"
+```
+
+Contract interfaces can extend other interfaces. An extended interface has to
+declare all entrypoints from every parent interface. All the declarations in the extended
+interface must have types compatible with the declarations from the parent
+interface.
+
+```
+contract interface II =
+  entrypoint f : () => unit
+
+contract interface I : II =
+  entrypoint f : () => unit
+  entrypoint g : () => unit
+
+contract C : I =
+  entrypoint f() = ()
+  entrypoint g() = ()
+```
+
+It is only possible to implement (or extend) an interface that has been already
+defined earlier in the file (or in an included file). Therefore recursive
+interface implementation is not allowed in Sophia.
+
+```
+// The following code would show an error
+
+contract interface X : Z =
+     entrypoint x : () => int
+
+ contract interface Y : X =
+     entrypoint x : () => int
+     entrypoint y : () => int
+
+ contract interface Z : Y =
+     entrypoint x : () => int
+     entrypoint y : () => int
+     entrypoint z : () => int
+
+ contract C : Z =
+     entrypoint x() = 1
+     entrypoint y() = 1
+     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)), 
+
+>Variance refers to how subtyping between more complex types relates to subtyping between their components.
+
+This concept plays an important role in complex types such as tuples, `datatype`s and functions. Depending on the context, it can apply to positions in the structure of a type, or type parameters of generic types. There are four kinds of variances:
+
+- covariant
+- contravariant
+- invariant
+- bivariant
+
+A type is said to be on a "covariant" position when it describes output or a result of some computation. Analogously, position is "contravariant" when it is an input, or a parameter. Intuitively, when a part of the type is produced by values of it, it is covariant. When it is consumed, it is contravariant. When a type appears to be simultaneously input and output, it is described as invariant. If a type is neither of those (that is, it's unused) it's bivariant. Furthermore, whenever a complex type appears on a contravariant position, all its covariant components become contravariant and vice versa.
+
+Variance influences how subtyping is applied. Types on covariant positions are subtyped normally, while contravariant the opposite way. Invariant types have to be exactly the same in order for subtyping to work. Bivariant types are always compatible.
+
+A good example of where it matters can be pictured by subtyping of function types. Let us assume there is a contract interface `Animal` and two contracts that implement it: `Dog` and `Cat`.
+
+```sophia
+contract interface Animal =
+  entrypoint age : () => int
+  
+contract Dog : Animal =
+  entrypoint age() = // ...
+  entrypoint woof() = "woof"
+  
+contract Cat : Animal =
+  entrypoint age() = // ...
+  entrypoint meow() = "meow"
+```
+
+The assumption of this exercise is that cats do not bark (because `Cat` does not define the `woof` entrypoint). If subtyping rules were applied naively, that is if we let `Dog => Dog` be a subtype of `Animal => Animal`, the following code would break:
+
+```sophia
+let f : (Dog) => string  = d => d.woof()
+let g : (Animal) => string  = f
+let c : Cat = Chain.create()
+g(c)  // Cat barking!
+```
+
+That is because arguments of functions are contravariant, as opposed to return the type which is covariant. Because of that, the assignment of `f` to `g` is invalid - while `Dog` is a subtype of `Animal`, `Dog => string` is **not** a subtype of `Animal => string`. However, `Animal => string` **is** a subtype of `Dog => string`. More than that, `(Dog => Animal) => Dog` is a subtype of `(Animal => Dog) => Animal`.
+
+This has consequences on how user-defined generic types work. A type variable gains its variance from its role in the type definition as shown in the example:
+
+```sophia
+datatype co('a) = Co('a) // co is covariant on 'a
+datatype ct('a) = Ct('a => unit) // ct is contravariant on 'a
+datatype in('a) = In('a => 'a) // in is invariant on 'a
+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
+
+That altogether induce the following rules of subtyping in Sophia:
+
+- A function type `(Args1) => Ret1` is a subtype of `(Args2) => Ret2` when `Ret1`
+is a subtype of `Ret2` and each argument type from `Args2` is a subtype of its
+counterpart in `Args1`.
+
+- A list type `list(A)` is a subtype of `list(B)` if `A` is a subtype of `B`.
+
+- An option type `option(A)` is a subtype of `option(B)` if `A` is a subtype of `B`.
+
+- A map type `map(A1, A2)` is a subtype of `map(B1, B2)` if `A1` is a subtype
+of `B1`, and `A2` is a subtype of `B2`.
+
+- An oracle type `oracle(A1, A2)` is a subtype of `oracle(B1, B2)` if `B1` is
+a subtype of `A1`, and `A2` is a subtype of `B2`.
+
+- An oracle_query type `oracle_query(A1, A2)` is a subtype of `oracle_query(B1, B2)`
+if `A1` is a subtype of `B1`, and `A2` is a subtype of `B2`.
+
+- A user-defined datatype `t(Args1)` is a subtype of `t(Args2)`
+
+- When a user-defined type `t('a)` is covariant in `'a`, then `t(A)` is a
+subtype of `t(B)` when `A` is a subtype of `B`.
+
+- When a user-defined type `t('a)` is contravariant in `'a`, then `t(A)` is a
+subtype of `t(B)` when `B` is a subtype of `A`.
+
+- When a user-defined type `t('a)` is binvariant in `'a`, then `t(A)` is a
+subtype of `t(B)` when either `A` is a subtype of `B` or when `B` is a subtype
+of `A`.
+
+- When a user-defined type `t('a)` is invariant in `'a`, then `t(A)` can never be
+a subtype of `t(B)`.
 
 ## Mutable state
 
@@ -400,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
@@ -862,6 +1061,16 @@ function require(b : bool, err : string) =
     if(!b) abort(err)
 ```
 
+Aside from that, there is an almost equivalent function `exit`
+
+```sophia
+exit(reason : string) : 'a
+```
+
+Just like `abort`, it breaks the execution with the given reason. The difference
+however is in the gas consumption — while `abort` returns unused gas, a call to
+`exit` burns it all.
+
 ## Delegation signature
 
 Some chain operations (`Oracle.<operation>` and `AENS.<operation>`) have an

docs/sophia_stdlib.md

@@ -483,7 +483,7 @@ The address of the account that mined the current block.
 Chain.timestamp : int
 ```
 
-The timestamp of the current block.
+The timestamp of the current block (unix time, milliseconds).
 
 
 ##### difficulty
@@ -812,8 +812,8 @@ Registers new oracle answering questions of type `'a` with answers of type `'b`.
   private key of the account, proving you have the private key of the oracle to be. If the
   address is the same as the contract `sign` is ignored and can be left out entirely.
 * The `qfee` is the minimum query fee to be paid by a user when asking a question of the oracle.
-* The `ttl` is the Time To Live for the oracle, either relative to the current
-  height (`RelativeTTL(delta)`) or a fixed height (`FixedTTL(height)`).
+* The `ttl` is the Time To Live for the oracle in key blocks, either relative to the current
+  key block height (`RelativeTTL(delta)`) or a fixed key block height (`FixedTTL(height)`).
 * The type `'a` is the type of the question to ask.
 * The type `'b` is the type of the oracle answers.
 

docs/sophia_syntax.md

@@ -10,8 +10,9 @@ and `*/` and can be nested.
 ### Keywords
 
 ```
-contract elif else entrypoint false function if import include let mod namespace
-private payable stateful switch true type record datatype main interface
+contract include let switch type record datatype if elif else function
+stateful payable true false mod public entrypoint private indexed namespace
+interface main using as for hiding
 ```
 
 ### Tokens
@@ -91,18 +92,31 @@ A Sophia file consists of a sequence of *declarations* in a layout block.
 ```c
 File ::= Block(TopDecl)
 
-TopDecl ::= ['payable'] 'contract' Con '=' Block(Decl)
-       | 'namespace' Con '=' Block(Decl)
-       | '@compiler' PragmaOp Version
-       | 'include' String
+TopDecl ::= ['payable'] ['main'] 'contract' Con [Implement] '=' Block(Decl)
+          | 'contract' 'interface' Con [Implement] '=' Block(Decl)
+          | 'namespace' Con '=' Block(Decl)
+          | '@compiler' PragmaOp Version
+          | 'include' String
+          | Using
+
+Implement ::= ':' Sep1(Con, ',')
 
 Decl ::= 'type'     Id ['(' TVar* ')'] '=' TypeAlias
        | 'record'   Id ['(' TVar* ')'] '=' RecordType
        | 'datatype' Id ['(' TVar* ')'] '=' DataType
+       | 'let'      Id [':' Type]      '=' Expr
        | (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
+       | Using
 
 FunDecl ::= Id ':' Type                             // Type signature
           | Id Args [':' Type] '=' Block(Stmt)      // Definition
+          | Id Args [':' Type] Block(GuardedDef)    // Guarded definitions
+
+GuardedDef ::= '|' Sep1(Expr, ',') '=' Block(Stmt)
+
+Using ::= 'using' Con ['as' Con] [UsingParts]
+UsingParts ::= 'for' '[' Sep1(Id, ',') ']'
+             | 'hiding' '[' Sep1(Id, ',') ']'
 
 PragmaOp ::= '<' | '=<' | '==' | '>=' | '>'
 Version  ::= Sep1(Int, '.')
@@ -172,12 +186,17 @@ Stmt ::= 'switch' '(' Expr ')' Block(Case)
        | 'elif' '(' Expr ')' Block(Stmt)
        | 'else' Block(Stmt)
        | 'let' LetDef
+       | Using
        | Expr
 
 LetDef ::= Id Args [':' Type] '=' Block(Stmt)   // Function definition
          | Pattern '=' Block(Stmt)              // Value definition
 
 Case    ::= Pattern '=>' Block(Stmt)
+          | Pattern Block(GuardedCase)
+
+GuardedCase ::= '|' Sep1(Expr, ',') '=>' Block(Stmt)
+
 Pattern ::= Expr
 ```
 
@@ -215,10 +234,12 @@ Expr ::= '(' LamArgs ')' '=>' Block(Stmt)   // Anonymous function    (x) => x +
        | '[' Expr '..' Expr ']'             // List range            [1..n]
        | '{' Sep(FieldUpdate, ',') '}'      // Record or map value   {x = 0, y = 1}, {[key] = val}
        | '(' Expr ')'                       // Parens                (1 + 2) * 3
+       | '(' Expr '=' Expr ')'              // Assign pattern        (y = x::_)
        | Id | Con | QId | QCon              // Identifiers           x, None, Map.member, AELib.Token
        | Int | Bytes | String | Char        // Literals              123, 0xff, #00abc123, "foo", '%'
        | AccountAddress | ContractAddress   // Chain identifiers
        | OracleAddress | OracleQueryId      // Chain identifiers
+       | '???'                              // Hole expression       1 + ???
 
 Generator ::= Pattern '<-' Expr   // Generator
             | 'if' '(' Expr ')'   // Guard
@@ -244,12 +265,12 @@ UnOp  ::= '-' | '!'
 | Operators | Type
 | --- | ---
 | `-` `+` `*` `/` `mod` `^` | arithmetic operators
-| `!` `&&` `\|\|` | logical operators
+| `!` `&&` `||` | logical operators
 | `==` `!=` `<` `>` `=<` `>=` | comparison operators
 | `::` `++` | list operators
-| `\|>` | functional operators
+| `|>` | functional operators
 
-## Operator precendences
+## Operator precedence
 
 In order of highest to lowest precedence.
 
@@ -263,5 +284,5 @@ In order of highest to lowest precedence.
 | `::` `++` | right
 | `<` `>` `=<` `>=` `==` `!=` | none
 | `&&` | right
-| `\|\|` | right
-| `\|>` | left
+| `||` | right
+| `|>` | left

rebar.config

@@ -2,11 +2,10 @@
 
 {erl_opts, [debug_info]}.
 
-{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {ref,"0699f35"}}}
+{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.2.0"}}}
        , {getopt, "1.0.1"}
        , {eblake2, "1.0.0"}
-       , {jsx, {git, "https://github.com/talentdeficit/jsx.git",
-                     {tag, "2.8.0"}}}
+       , {jsx, {git, "https://github.com/talentdeficit/jsx.git", {tag, "2.8.0"}}}
        ]}.
 
 {dialyzer, [
@@ -15,7 +14,7 @@
             {base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
            ]}.
 
-{relx, [{release, {aesophia, "6.1.0"},
+{relx, [{release, {aesophia, "7.1.0"},
          [aesophia, aebytecode, getopt]},
 
         {dev_mode, true},

rebar.lock

@@ -1,11 +1,11 @@
-{"1.1.0",
+{"1.2.0",
 [{<<"aebytecode">>,
   {git,"https://github.com/aeternity/aebytecode.git",
-       {ref,"0699f35b0398bac6cd4468da654d608375bd853d"}},
+       {ref,"2a0a397afad6b45da52572170f718194018bf33c"}},
   0},
  {<<"aeserialization">>,
   {git,"https://github.com/aeternity/aeserialization.git",
-       {ref,"47aaa8f5434b365c50a35bfd1490340b19241991"}},
+       {ref,"eb68fe331bd476910394966b7f5ede7a74d37e35"}},
   1},
  {<<"base58">>,
   {git,"https://github.com/aeternity/erl-base58.git",
@@ -14,7 +14,7 @@
  {<<"eblake2">>,{pkg,<<"eblake2">>,<<"1.0.0">>},0},
  {<<"enacl">>,
   {git,"https://github.com/aeternity/enacl.git",
-       {ref,"26180f42c0b3a450905d2efd8bc7fd5fd9cece75"}},
+       {ref,"793ddb502f7fe081302e1c42227dca70b09f8e17"}},
   2},
  {<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0},
  {<<"jsx">>,
@@ -24,5 +24,8 @@
 [
 {pkg_hash,[
  {<<"eblake2">>, <<"EC8AD20E438AAB3F2E8D5D118C366A0754219195F8A0F536587440F8F9BCF2EF">>},
- {<<"getopt">>, <<"C73A9FA687B217F2FF79F68A3B637711BB1936E712B521D8CE466B29CBF7808A">>}]}
+ {<<"getopt">>, <<"C73A9FA687B217F2FF79F68A3B637711BB1936E712B521D8CE466B29CBF7808A">>}]},
+{pkg_hash_ext,[
+ {<<"eblake2">>, <<"3C4D300A91845B25D501929A26AC2E6F7157480846FAB2347A4C11AE52E08A99">>},
+ {<<"getopt">>, <<"53E1AB83B9CEB65C9672D3E7A35B8092E9BDC9B3EE80721471A161C10C59959C">>}]}
 ].

src/aeso_aci.erl

@@ -83,7 +83,7 @@ from_typed_ast(Type, TypedAst) ->
         string -> do_render_aci_json(JArray)
     end.
 
-encode_contract(Contract = {Head, _, {con, _, Name}, _}) when ?IS_CONTRACT_HEAD(Head) ->
+encode_contract(Contract = {Head, _, {con, _, Name}, _, _}) when ?IS_CONTRACT_HEAD(Head) ->
     C0 = #{name => encode_name(Name)},
 
     Tdefs0 = [ encode_typedef(T) || T <- sort_decls(contract_types(Contract)) ],
@@ -91,7 +91,7 @@ encode_contract(Contract = {Head, _, {con, _, Name}, _}) when ?IS_CONTRACT_HEAD(
     {Es, Tdefs1} = lists:partition(FilterT(<<"event">>), Tdefs0),
     {Ss, Tdefs}  = lists:partition(FilterT(<<"state">>), Tdefs1),
 
-    C1 = C0#{type_defs => Tdefs},
+    C1 = C0#{typedefs => Tdefs},
 
     C2 = case Es of
              []                 -> C1;
@@ -111,7 +111,7 @@ encode_contract(Contract = {Head, _, {con, _, Name}, _}) when ?IS_CONTRACT_HEAD(
 encode_contract(Namespace = {namespace, _, {con, _, Name}, _}) ->
     Tdefs = [ encode_typedef(T) || T <- sort_decls(contract_types(Namespace)) ],
     #{namespace => #{name => encode_name(Name),
-                     type_defs => Tdefs}}.
+                     typedefs => Tdefs}}.
 
 %%  Encode a function definition. Currently we are only interested in
 %%  the interface and type.
@@ -234,7 +234,7 @@ do_render_aci_json(Json) ->
 decode_contract(#{contract := #{name := Name,
                                 kind := Kind,
                                 payable := Payable,
-                                type_defs := Ts0,
+                                typedefs := Ts0,
                                 functions := Fs} = C}) ->
     MkTDef = fun(N, T) -> #{name => N, vars => [], typedef => T} end,
     Ts = [ MkTDef(<<"state">>, maps:get(state, C)) || maps:is_key(state, C) ] ++
@@ -246,7 +246,7 @@ decode_contract(#{contract := #{name := Name,
                        end,
      io_lib:format("~s", [Name])," =\n",
      decode_tdefs(Ts), decode_funcs(Fs)];
-decode_contract(#{namespace := #{name := Name, type_defs := Ts}}) when Ts /= [] ->
+decode_contract(#{namespace := #{name := Name, typedefs := Ts}}) when Ts /= [] ->
     ["namespace ", io_lib:format("~s", [Name])," =\n",
      decode_tdefs(Ts)];
 decode_contract(_) -> [].
@@ -341,10 +341,12 @@ stateful(false) -> "".
 
 %% #contract{Ann, Con, [Declarations]}.
 
-contract_funcs({C, _, _, Decls}) when ?IS_CONTRACT_HEAD(C); C == namespace ->
+contract_funcs({C, _, _, _, Decls}) when ?IS_CONTRACT_HEAD(C) ->
     [ D || D <- Decls, is_fun(D)].
 
-contract_types({C, _, _, Decls}) when ?IS_CONTRACT_HEAD(C); C == namespace ->
+contract_types({namespace, _, _, Decls}) ->
+    [ D || D <- Decls, is_type(D) ];
+contract_types({C, _, _, _, Decls}) when ?IS_CONTRACT_HEAD(C) ->
     [ D || D <- Decls, is_type(D) ].
 
 is_fun({letfun, _, _, _, _, _}) -> true;

src/aeso_ast.erl

@@ -1,27 +0,0 @@
--module(aeso_ast).
-
--export([int/2,
-         line/1,
-         pp/1,
-         pp_typed/1,
-         symbol/2,
-         symbol_name/1
-        ]).
-
-
-symbol(Line, Chars) -> {symbol, Line, Chars}.
-int(Line, Int) -> {'Int', Line, Int}.
-
-line({symbol, Line, _}) -> Line.
-
-symbol_name({symbol, _, Name}) -> Name.
-
-pp(Ast) ->
-    String = prettypr:format(aeso_pretty:decls(Ast, [])),
-    io:format("Ast:\n~s\n", [String]).
-
-pp_typed(TypedAst) ->
-    %% io:format("Typed tree:\n~p\n",[TypedAst]),
-    String = prettypr:format(aeso_pretty:decls(TypedAst, [show_generated])),
-    io:format("Type ast:\n~s\n",[String]).
-

src/aeso_ast_to_fcode.erl

@@ -149,17 +149,19 @@
 
 -type state_layout() :: {tuple, [state_layout()]} | {reg, state_reg()}.
 
--type env() :: #{ type_env      := type_env(),
-                  fun_env       := fun_env(),
-                  con_env       := con_env(),
-                  child_con_env := child_con_env(),
-                  event_type    => aeso_syntax:typedef(),
-                  builtins      := builtins(),
-                  options       := [option()],
-                  state_layout  => state_layout(),
-                  context       => context(),
-                  vars          => [var_name()],
-                  functions     := #{ fun_name() => fun_def() }
+-type env() :: #{ type_env          := type_env(),
+                  fun_env           := fun_env(),
+                  con_env           := con_env(),
+                  child_con_env     := child_con_env(),
+                  event_type        => aeso_syntax:typedef(),
+                  builtins          := builtins(),
+                  options           := [option()],
+                  state_layout      => state_layout(),
+                  context           => context(),
+                  vars              => [var_name()],
+                  functions         := #{ fun_name() => fun_def() },
+                  consts            := #{ var_name() => fexpr() },
+                  saved_fresh_names => #{ var_name() => var_name() }
                }.
 
 -define(HASH_BYTES, 32).
@@ -170,7 +172,7 @@
 %% and produces Fate intermediate code.
 -spec ast_to_fcode(aeso_syntax:ast(), [option()]) -> {env(), fcode()}.
 ast_to_fcode(Code, Options) ->
-    init_fresh_names(),
+    init_fresh_names(Options),
     {Env1, FCode1} = to_fcode(init_env(Options), Code),
     FCode2 = optimize(FCode1, Options),
     Env2 = Env1#{ child_con_env :=
@@ -178,13 +180,18 @@ ast_to_fcode(Code, Options) ->
                         fun (_, FC) -> optimize(FC, Options) end,
                         maps:get(child_con_env, Env1)
                        )},
-    clear_fresh_names(),
-    {Env2, FCode2}.
+    Env3 =
+        case proplists:get_value(debug_info, Options, false) of
+            true  -> Env2#{ saved_fresh_names => get(saved_fresh_names) };
+            false -> Env2
+        end,
+    clear_fresh_names(Options),
+    {Env3, FCode2}.
 
 optimize(FCode1, Options) ->
     Verbose = lists:member(pp_fcode, Options),
     [io:format("-- Before lambda lifting --\n~s\n\n", [format_fcode(FCode1)]) || Verbose],
-    FCode2 = optimize_fcode(FCode1),
+    FCode2 = optimize_fcode(FCode1, Options),
     [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ],
     FCode3 = lambda_lift(FCode2),
     [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ],
@@ -234,7 +241,8 @@ init_env(Options) ->
                       ["Chain", "GAAttachTx"]             => #con_tag{ tag = 21, arities = ChainTxArities }
                      },
        options   => Options,
-       functions => #{}
+       functions => #{},
+       consts    => #{}
     }.
 
 -spec builtins() -> builtins().
@@ -242,7 +250,7 @@ builtins() ->
     MkName = fun(NS, Fun) ->
                 list_to_atom(string:to_lower(string:join(NS ++ [Fun], "_")))
              end,
-    Scopes = [{[],           [{"abort", 1}, {"require", 2}]},
+    Scopes = [{[],           [{"abort", 1}, {"require", 2}, {"exit", 1}]},
               {["Chain"],    [{"spend", 2}, {"balance", 1}, {"block_hash", 1}, {"coinbase", none},
                               {"timestamp", none}, {"block_height", none}, {"difficulty", none},
                               {"gas_limit", none}, {"bytecode_hash", 1}, {"create", variable}, {"clone", variable}]},
@@ -326,7 +334,7 @@ get_option(Opt, Env, Default) ->
 %% -- Compilation ------------------------------------------------------------
 
 -spec to_fcode(env(), aeso_syntax:ast()) -> {env(), fcode()}.
-to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, Decls}|Rest])
+to_fcode(Env, [{Contract, Attrs, {con, _, Name}, _Impls, Decls}|Rest])
   when ?IS_CONTRACT_HEAD(Contract) ->
     case Contract =:= contract_interface of
         false ->
@@ -349,7 +357,7 @@ to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, Decls}|Rest])
                           event_type    => EventType,
                           payable       => Payable,
                           functions     => add_init_function(
-                                             Env1, Con, StateType,
+                                             Env1,
                                              add_event_function(Env1, EventType, Funs)) },
             case Contract of
                 contract_main -> [] = Rest, {Env1, ConFcode};
@@ -362,8 +370,6 @@ to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, Decls}|Rest])
             Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Name} }, Decls),
             to_fcode(Env1, Rest)
     end;
-to_fcode(_Env, [NotMain = {NotMainHead, _ ,_ , _}]) when NotMainHead =/= contract_def ->
-    fcode_error({last_declaration_must_be_main_contract, NotMain});
 to_fcode(Env, [{namespace, _, {con, _, Con}, Decls} | Code]) ->
     Env1 = decls_to_fcode(Env#{ context => {namespace, Con} }, Decls),
     to_fcode(Env1, Code).
@@ -377,32 +383,28 @@ decls_to_fcode(Env, Decls) ->
                 end, Env1, Decls).
 
 -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env().
-decl_to_fcode(Env = #{context := {contract_def, _}}, {fun_decl, _, Id, _}) ->
-    case is_no_code(Env) of
-        false -> fcode_error({missing_definition, Id});
-        true  -> Env
-    end;
 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 = {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) ->
+decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) ->
     Attrs = get_attributes(Ann),
     FName = lookup_fun(Env, qname(Env, Name)),
     FArgs = args_to_fcode(Env, Args),
     FRet  = type_to_fcode(Env, Ret),
     FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body),
-    [ ensure_first_order_entrypoint(Ann, Id, Args, Ret, FArgs, FRet)
-      || aeso_syntax:get_ann(entrypoint, Ann, false) ],
     Def   = #{ attrs  => Attrs,
                args   => FArgs,
                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 = {id, _, Name}, Xs, Def) ->
-    check_state_and_event_types(Env, Id, Xs),
+typedef_to_fcode(Env, {id, _, Name}, Xs, Def) ->
     Q = qname(Env, Name),
     FDef = fun(Args) when length(Args) == length(Xs) ->
                 Sub = maps:from_list(lists:zip([X || {tvar, _, X} <- Xs], Args)),
@@ -466,14 +468,6 @@ compute_state_layout(R, [H | T]) ->
 compute_state_layout(R, _) ->
     {R + 1, {reg, R}}.
 
-check_state_and_event_types(#{ context := {contract_def, _} }, Id, [_ | _]) ->
-    case Id of
-        {id, _, "state"} -> fcode_error({parameterized_state, Id});
-        {id, _, "event"} -> fcode_error({parameterized_event, Id});
-        _                -> ok
-    end;
-check_state_and_event_types(_, _, _) -> ok.
-
 -spec type_to_fcode(env(), aeso_syntax:type()) -> ftype().
 type_to_fcode(Env, Type) ->
     type_to_fcode(Env, #{}, Type).
@@ -491,8 +485,6 @@ type_to_fcode(Env, Sub, {record_t, Fields}) ->
     type_to_fcode(Env, Sub, {tuple_t, [], lists:map(FieldType, Fields)});
 type_to_fcode(_Env, _Sub, {bytes_t, _, N}) ->
     {bytes, N};
-type_to_fcode(_Env, _Sub, {tvar, Ann, "void"}) ->
-    fcode_error({found_void, Ann});
 type_to_fcode(_Env, Sub, {tvar, _, X}) ->
     maps:get(X, Sub, {tvar, X});
 type_to_fcode(_Env, _Sub, {fun_t, Ann, _, var_args, _}) ->
@@ -554,7 +546,7 @@ expr_to_fcode(_Env, _Type, {bytes,           _, B}) -> {lit, {bytes, B}};
 
 %% Variables
 expr_to_fcode(Env, _Type, {id, _, X})  -> resolve_var(Env, [X]);
-expr_to_fcode(Env, Type, {qid, Ann, 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;
@@ -565,13 +557,11 @@ expr_to_fcode(Env, Type, {qid, Ann, X}) ->
                                 B =:= oracle_check_query ->
             OType = get_oracle_type(B, Type),
             {oracle, QType, RType} = type_to_fcode(Env, OType),
-            validate_oracle_type(Ann, OType, QType, RType),
             TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
             {builtin_u, B, Ar, TypeArgs};
         {builtin_u, B = aens_resolve, Ar} ->
             {fun_t, _, _, _, ResType} = Type,
             AensType = type_to_fcode(Env, ResType),
-            validate_aens_resolve_type(Ann, ResType, AensType),
             TypeArgs = [{lit, {typerep, AensType}}],
             {builtin_u, B, Ar, TypeArgs};
         {builtin_u, B = bytes_split, Ar} ->
@@ -715,7 +705,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) ->
     end;
 
 %% Function calls
-expr_to_fcode(Env, Type, {app, _, Fun = {typed, _, FunE, {fun_t, _, NamedArgsT, ArgsT, _}}, Args}) ->
+expr_to_fcode(Env, _, {app, _, Fun = {typed, _, 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
@@ -824,53 +814,6 @@ get_oracle_type(oracle_check,        {fun_t, _, _, [OType | _], _}) -> OType;
 get_oracle_type(oracle_check_query,  {fun_t, _, _, [OType | _], _}) -> OType;
 get_oracle_type(oracle_respond,      {fun_t, _, _, [OType | _], _}) -> OType.
 
-validate_oracle_type(Ann, Type, QType, RType) ->
-    ensure_monomorphic(QType, {invalid_oracle_type, polymorphic,  query,    Ann, Type}),
-    ensure_monomorphic(RType, {invalid_oracle_type, polymorphic,  response, Ann, Type}),
-    ensure_first_order(QType, {invalid_oracle_type, higher_order, query,    Ann, Type}),
-    ensure_first_order(RType, {invalid_oracle_type, higher_order, response, Ann, Type}),
-    ok.
-
-validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]}) ->
-    case FType of
-        string         -> ok;
-        address        -> ok;
-        contract       -> ok;
-        {oracle, _, _} -> ok;
-        oracle_query   -> ok;
-        _              -> fcode_error({invalid_aens_resolve_type, Ann, Type})
-    end.
-
-ensure_first_order_entrypoint(Ann, Id = {id, _, Name}, Args, Ret, FArgs, FRet) ->
-    [ ensure_first_order(FT, {invalid_entrypoint, higher_order, Ann1, Id, {argument, X, T}})
-      || {{typed, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ],
-    [ ensure_first_order(FRet, {invalid_entrypoint, higher_order, Ann, Id, {result, Ret}})
-      || Name /= "init" ],  %% init can return higher-order values, since they're written to the store
-                            %% rather than being returned.
-    ok.
-
-ensure_monomorphic(Type, Err) ->
-    case is_monomorphic(Type) of
-        true  -> ok;
-        false -> fcode_error(Err)
-    end.
-
-ensure_first_order(Type, Err) ->
-    case is_first_order(Type) of
-        true  -> ok;
-        false -> fcode_error(Err)
-    end.
-
-is_monomorphic({tvar, _})              -> false;
-is_monomorphic(Ts) when is_list(Ts)    -> lists:all(fun is_monomorphic/1, Ts);
-is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
-is_monomorphic(_)                      -> true.
-
-is_first_order({function, _, _})       -> false;
-is_first_order(Ts) when is_list(Ts)    -> lists:all(fun is_first_order/1, Ts);
-is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
-is_first_order(_)                      -> true.
-
 %% -- Pattern matching --
 
 -spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()], aeso_syntax:expr()) -> fsplit().
@@ -1203,11 +1146,11 @@ builtin_to_fcode(_Layout, Builtin, Args) ->
 
 %% -- Init function --
 
-add_init_function(Env, Main, StateType, Funs0) ->
+add_init_function(Env, Funs0) ->
     case is_no_code(Env) of
         true  -> Funs0;
         false ->
-            Funs     = add_default_init_function(Env, Main, StateType, Funs0),
+            Funs     = add_default_init_function(Env, Funs0),
             InitName = {entrypoint, <<"init">>},
             InitFun  = #{ body := InitBody} = maps:get(InitName, Funs),
             Funs1 = Funs#{ InitName => InitFun#{ return => {tuple, []},
@@ -1215,16 +1158,14 @@ add_init_function(Env, Main, StateType, Funs0) ->
             Funs1
     end.
 
-add_default_init_function(_Env, Main, StateType, Funs) ->
+add_default_init_function(_Env, Funs) ->
     InitName = {entrypoint, <<"init">>},
     case maps:get(InitName, Funs, none) of
-        %% Only add default init function if state is unit.
-        none when StateType == {tuple, []} ->
+        none ->
             Funs#{ InitName => #{attrs  => [],
                                  args   => [],
                                  return => {tuple, []},
                                  body   => {tuple, []}} };
-        none -> fcode_error({missing_init_function, Main});
         _    -> Funs
     end.
 
@@ -1358,20 +1299,28 @@ lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As].
 %% - Constant propagation
 %% - Inlining
 
--spec optimize_fcode(fcode()) -> fcode().
-optimize_fcode(Code = #{ functions := Funs }) ->
-    Code1 = Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def) end, Funs) },
+-spec optimize_fcode(fcode(), [option()]) -> fcode().
+optimize_fcode(Code = #{ functions := Funs }, Options) ->
+    Code1 = Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def, Options) end, Funs) },
     eliminate_dead_code(Code1).
 
--spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def().
-optimize_fun(Fcode, Fun, Def = #{ body := Body }) ->
-    %% io:format("Optimizing ~p =\n~s\n", [_Fun, prettypr:format(pp_fexpr(_Body))]),
-    Def#{ body := drop_unused_lets(
-                  simplifier(
-                  let_floating(
-                  bind_subexpressions(
-                  inline_local_functions(
-                  inliner(Fcode, Fun, Body)))))) }.
+-spec optimize_fun(fcode(), fun_name(), fun_def(), [option()]) -> fun_def().
+optimize_fun(Fcode, Fun, Def = #{ body := Body0 }, Options) ->
+    Inliner              = proplists:get_value(optimize_inliner,                Options, true),
+    InlineLocalFunctions = proplists:get_value(optimize_inline_local_functions, Options, true),
+    BindSubexpressions   = proplists:get_value(optimize_bind_subexpressions,    Options, true),
+    LetFloating          = proplists:get_value(optimize_let_floating,           Options, true),
+    Simplifier           = proplists:get_value(optimize_simplifier,             Options, true),
+    DropUnusedLets       = proplists:get_value(optimize_drop_unused_lets,       Options, true),
+
+    Body1 = if Inliner              -> inliner   (Fcode, Fun, Body0); true -> Body0 end,
+    Body2 = if InlineLocalFunctions -> inline_local_functions(Body1); true -> Body1 end,
+    Body3 = if BindSubexpressions   -> bind_subexpressions   (Body2); true -> Body2 end,
+    Body4 = if LetFloating          -> let_floating          (Body3); true -> Body3 end,
+    Body5 = if Simplifier           -> simplifier            (Body4); true -> Body4 end,
+    Body6 = if DropUnusedLets       -> drop_unused_lets      (Body5); true -> Body5 end,
+
+    Def#{ body := Body6 }.
 
 %% --- Inlining ---
 
@@ -1779,9 +1728,23 @@ bind_var(Env = #{ vars := Vars }, X) -> Env#{ vars := [X | Vars] }.
 resolve_var(#{ vars := Vars } = Env, [X]) ->
     case lists:member(X, Vars) of
         true  -> {var, X};
-        false -> resolve_fun(Env, [X])
+        false ->
+            case resolve_const(Env, [X]) of
+                false -> resolve_fun(Env, [X]);
+                Const -> Const
+            end
     end;
-resolve_var(Env, Q) -> resolve_fun(Env, Q).
+resolve_var(Env, Q) ->
+    case resolve_const(Env, Q) of
+        false -> resolve_fun(Env, Q);
+        Const -> Const
+    end.
+
+resolve_const(#{ consts := Consts }, Q) ->
+    case maps:get(Q, Consts, not_found) of
+        not_found -> false;
+        Val       -> Val
+    end.
 
 resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, Q) ->
     case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of
@@ -1791,12 +1754,29 @@ resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, Q) ->
         {{Fun, Ar}, _}         -> {def_u, Fun, Ar}
     end.
 
-init_fresh_names() ->
+init_fresh_names(Options) ->
+    proplists:get_value(debug_info, Options, false) andalso init_saved_fresh_names(),
     put('%fresh', 0).
 
-clear_fresh_names() ->
+clear_fresh_names(Options) ->
+    proplists:get_value(debug_info, Options, false) andalso clear_saved_fresh_names(),
     erase('%fresh').
 
+init_saved_fresh_names() ->
+    put(saved_fresh_names, #{}).
+
+clear_saved_fresh_names() ->
+    erase(saved_fresh_names).
+
+-spec fresh_name_save(string()) -> var_name().
+fresh_name_save(Name) ->
+    Fresh = fresh_name(),
+    case get(saved_fresh_names) of
+        undefined -> ok;
+        Old       -> put(saved_fresh_names, Old#{Fresh => Name})
+    end,
+    Fresh.
+
 -spec fresh_name() -> var_name().
 fresh_name() -> fresh_name("%").
 
@@ -1925,7 +1905,7 @@ bottom_up(F, Env, Expr) ->
                                (_)            -> true end,
             case ShouldFreshen(X) of
                 true ->
-                    Z = fresh_name(),
+                    Z = fresh_name_save(X),
                     Env1 = Env#{ Z => E1 },
                     {'let', Z, E1, bottom_up(F, Env1, rename([{X, Z}], Body))};
                 false ->
@@ -2090,7 +2070,9 @@ setnth(I, X, Xs) ->
 -dialyzer({nowarn_function, [fcode_error/1, internal_error/1]}).
 
 fcode_error(Error) ->
-    aeso_errors:throw(aeso_code_errors:format(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)).
 
 internal_error(Error) ->
     Msg = lists:flatten(io_lib:format("~p\n", [Error])),

src/aeso_code_errors.erl

@@ -1,94 +0,0 @@
-%%%-------------------------------------------------------------------
-%%% @author Ulf Norell
-%%% @copyright (C) 2019, Aeternity Anstalt
-%%% @doc
-%%%     Formatting of code generation errors.
-%%% @end
-%%%
-%%%-------------------------------------------------------------------
--module(aeso_code_errors).
-
--export([format/1, pos/1]).
-
-format({last_declaration_must_be_main_contract, Decl = {Kind, _, {con, _, C}, _}}) ->
-    Msg = io_lib:format("Expected a main contract as the last declaration instead of the ~p '~s'",
-                        [Kind, C]),
-    mk_err(pos(Decl), Msg);
-format({missing_init_function, Con}) ->
-    Msg = io_lib:format("Missing init function for the contract '~s'.", [pp_expr(Con)]),
-    Cxt = "The 'init' function can only be omitted if the state type is 'unit'.",
-    mk_err(pos(Con), Msg, Cxt);
-format({missing_definition, Id}) ->
-    Msg = io_lib:format("Missing definition of function '~s'.", [pp_expr(Id)]),
-    mk_err(pos(Id), Msg);
-format({parameterized_state, Decl}) ->
-    Msg = "The state type cannot be parameterized.",
-    mk_err(pos(Decl), Msg);
-format({parameterized_event, Decl}) ->
-    Msg = "The event type cannot be parameterized.",
-    mk_err(pos(Decl), Msg);
-format({invalid_entrypoint, Why, Ann, {id, _, Name}, Thing}) ->
-    What = case Why of higher_order -> "higher-order (contains function types)";
-                       polymorphic  -> "polymorphic (contains type variables)" end,
-    ThingS = case Thing of
-                 {argument, X, T} -> io_lib:format("argument\n~s\n", [pp_typed(X, T)]);
-                 {result, T}      -> io_lib:format("return type\n~s\n", [pp_type(2, T)])
-             end,
-    Bad = case Thing of
-              {argument, _, _} -> io_lib:format("has a ~s type", [What]);
-              {result, _}      -> io_lib:format("is ~s", [What])
-          end,
-    Msg = io_lib:format("The ~sof entrypoint '~s' ~s.",
-                        [ThingS, Name, Bad]),
-    case Why of
-        higher_order -> mk_err(pos(Ann), Msg)
-    end;
-format({invalid_aens_resolve_type, Ann, T}) ->
-    Msg = io_lib:format("Invalid return type of AENS.resolve:\n"
-                        "~s\n"
-                        "It must be a string or a pubkey type (address, oracle, etc).",
-                        [pp_type(2, T)]),
-    mk_err(pos(Ann), Msg);
-format({invalid_oracle_type, Why, What, Ann, Type}) ->
-    WhyS = case Why of higher_order -> "higher-order (contain function types)";
-                       polymorphic  -> "polymorphic (contain type variables)" end,
-    Msg = io_lib:format("Invalid oracle type\n~s", [pp_type(2, Type)]),
-    Cxt = io_lib:format("The ~s type must not be ~s.", [What, WhyS]),
-    mk_err(pos(Ann), Msg, Cxt);
-format({var_args_not_set, Expr}) ->
-    mk_err( pos(Expr), "Could not deduce type of variable arguments list"
-          , "When compiling " ++ pp_expr(Expr)
-          );
-format({found_void, Ann}) ->
-    mk_err(pos(Ann), "Found a void-typed value.", "`void` is a restricted, uninhabited type. Did you mean `unit`?");
-
-format(Err) ->
-    mk_err(aeso_errors:pos(0, 0), io_lib:format("Unknown error: ~p\n", [Err])).
-
-pos(Ann) ->
-    File = aeso_syntax:get_ann(file, Ann, no_file),
-    Line = aeso_syntax:get_ann(line, Ann, 0),
-    Col  = aeso_syntax:get_ann(col, Ann, 0),
-    aeso_errors:pos(File, Line, Col).
-
-pp_typed(E, T) ->
-    prettypr:format(prettypr:nest(2,
-    lists:foldr(fun prettypr:beside/2, prettypr:empty(),
-                [aeso_pretty:expr(E), prettypr:text(" : "),
-                 aeso_pretty:type(T)]))).
-
-pp_expr(E) ->
-    pp_expr(0, E).
-
-pp_expr(N, E) ->
-    prettypr:format(prettypr:nest(N, aeso_pretty:expr(E))).
-
-pp_type(N, T) ->
-    prettypr:format(prettypr:nest(N, aeso_pretty:type(T))).
-
-mk_err(Pos, Msg) ->
-    aeso_errors:new(code_error, Pos, lists:flatten(Msg)).
-
-mk_err(Pos, Msg, Cxt) ->
-    aeso_errors:new(code_error, Pos, lists:flatten(Msg), lists:flatten(Cxt)).
-

src/aeso_compiler.erl

@@ -112,10 +112,12 @@ from_string(ContractString, Options) ->
 
 from_string1(ContractString, Options) ->
     #{ fcode := FCode
-     , fcode_env := #{child_con_env := ChildContracts}
+     , fcode_env := FCodeEnv
      , folded_typed_ast := FoldedTypedAst
      , warnings := Warnings } = string_to_code(ContractString, Options),
-    FateCode = aeso_fcode_to_fate:compile(ChildContracts, FCode, Options),
+    #{ child_con_env := ChildContracts } = FCodeEnv,
+    SavedFreshNames = maps:get(saved_fresh_names, FCodeEnv, #{}),
+    {FateCode, VarsRegs} = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
     pp_assembler(FateCode, Options),
     ByteCode = aeb_fate_code:serialize(FateCode, []),
     {ok, Version} = version(),
@@ -128,7 +130,13 @@ from_string1(ContractString, Options) ->
             payable => maps:get(payable, FCode),
             warnings => Warnings
            },
-    {ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}.
+    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)}.
 
 maybe_generate_aci(Result, FoldedTypedAst, Options) ->
     case proplists:get_value(aci, Options) of
@@ -185,7 +193,7 @@ check_call1(ContractString0, FunName, Args, Options) ->
         #{fcode := OrgFcode
         , fcode_env := #{child_con_env := ChildContracts}
         , ast := Ast} = string_to_code(ContractString0, Options),
-        FateCode = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, []),
+        {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,
@@ -238,8 +246,8 @@ insert_init_function(Code, Options) ->
 
 last_contract_indent(Decls) ->
     case lists:last(Decls) of
-        {_, _, _, [Decl | _]} -> aeso_syntax:get_ann(col, Decl, 1) - 1;
-        _                     -> 0
+        {_, _, _, _, [Decl | _]} -> aeso_syntax:get_ann(col, Decl, 1) - 1;
+        _                        -> 0
     end.
 
 -spec to_sophia_value(string(), string(), ok | error | revert, binary()) ->
@@ -264,7 +272,7 @@ to_sophia_value(ContractString, FunName, ok, Data, Options0) ->
         Code = string_to_code(ContractString, Options),
         #{ unfolded_typed_ast := TypedAst, type_env  := TypeEnv} = Code,
         {ok, _, Type0} = get_decode_type(FunName, TypedAst),
-        Type   = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
+        Type   = aeso_tc_type_unfolding: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))}
@@ -315,7 +323,7 @@ decode_calldata(ContractString, FunName, Calldata, Options0) ->
         ArgTypes      = lists:map(GetType, Args),
         Type0         = {tuple_t, [], ArgTypes},
         %% user defined data types such as variants needed to match against
-        Type          = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
+        Type          = aeso_tc_type_unfolding:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
         case aeb_fate_abi:decode_calldata(FunName, Calldata) of
             {ok, FateArgs} ->
                 try
@@ -338,7 +346,7 @@ decode_calldata(ContractString, FunName, Calldata, Options0) ->
     end.
 
 -dialyzer({nowarn_function, get_decode_type/2}).
-get_decode_type(FunName, [{Contract, Ann, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) ->
+get_decode_type(FunName, [{Contract, Ann, _, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) ->
     GetType = fun({letfun, _, {id, _, Name}, Args, Ret, _})               when Name == FunName -> [{Args, Ret}];
                  ({fun_decl, _, {id, _, Name}, {fun_t, _, _, Args, Ret}}) when Name == FunName -> [{Args, Ret}];
                  (_) -> [] end,
@@ -349,7 +357,7 @@ get_decode_type(FunName, [{Contract, Ann, _, Defs}]) when ?IS_CONTRACT_HEAD(Cont
                 "init" -> {ok, [], {tuple_t, [], []}};
                  _ ->
                     Msg = io_lib:format("Function '~s' is missing in contract", [FunName]),
-                    Pos = aeso_code_errors:pos(Ann),
+                    Pos = aeso_errors:pos(Ann),
                     aeso_errors:throw(aeso_errors:new(data_error, Pos, Msg))
             end
     end;

src/aeso_errors.erl

@@ -34,6 +34,7 @@
         , new/2
         , new/3
         , new/4
+        , pos/1
         , pos/2
         , pos/3
         , pp/1
@@ -53,6 +54,12 @@ new(Type, Pos, Msg) ->
 new(Type, Pos, Msg, Ctxt) ->
     #err{ type = Type, pos = Pos, message = Msg, context = Ctxt }.
 
+pos(Ann) ->
+    File = aeso_syntax:get_ann(file, Ann, no_file),
+    Line = aeso_syntax:get_ann(line, Ann, 0),
+    Col  = aeso_syntax:get_ann(col, Ann, 0),
+    pos(File, Line, Col).
+
 pos(Line, Col) ->
     #pos{ line = Line, col = Col }.
 

src/aeso_fcode_to_fate.erl

@@ -9,7 +9,7 @@
 %%%-------------------------------------------------------------------
 -module(aeso_fcode_to_fate).
 
--export([compile/2, compile/3, term_to_fate/1, term_to_fate/2]).
+-export([compile/3, compile/4, term_to_fate/1, term_to_fate/2]).
 
 -ifdef(TEST).
 -export([optimize_fun/4, to_basic_blocks/1]).
@@ -45,7 +45,14 @@
 -define(s(N), {store, N}).
 -define(void, {var, 9999}).
 
--record(env, { contract, vars = [], locals = [], current_function, tailpos = true, child_contracts = #{}, options = []}).
+-record(env, { contract,
+               vars              = [],
+               locals            = [],
+               current_function,
+               tailpos           = true,
+               child_contracts   = #{},
+               saved_fresh_names = #{},
+               options           = [] }).
 
 %% -- Debugging --------------------------------------------------------------
 
@@ -64,21 +71,34 @@ debug(Tag, Options, Fun) ->
 
 -dialyzer({nowarn_function, [code_error/1]}).
 code_error(Err) ->
-    aeso_errors:throw(aeso_code_errors:format(Err)).
+    Pos = aeso_errors:pos(0, 0),
+    Msg = lists:flatten(io_lib:format("Unknown error: ~p\n", [Err])),
+    aeso_errors:throw(aeso_errors:new(code_error, Pos, Msg)).
 
 %% -- Main -------------------------------------------------------------------
 
 %% @doc Main entry point.
-compile(FCode, Options) ->
-    compile(#{}, FCode, Options).
-compile(ChildContracts, FCode, Options) ->
+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, Options),
+    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)]),
-    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()}.
 
 make_function_id(X) ->
     aeb_fate_code:symbol_identifier(make_function_name(X)).
@@ -87,22 +107,48 @@ make_function_name(event)              -> <<"Chain.event">>;
 make_function_name({entrypoint, Name}) -> Name;
 make_function_name({local_fun, Xs})    -> list_to_binary("." ++ string:join(Xs, ".")).
 
-functions_to_scode(ChildContracts, ContractName, Functions, Options) ->
+add_child_symbols(ChildContracts, FateCode) ->
+    Funs = lists:flatten([ maps:keys(ChildFuns) || {_, #{functions := ChildFuns}} <- maps:to_list(ChildContracts) ]),
+    Symbols = maps:from_list([ {make_function_id(FName), make_function_name(FName)} || FName <- Funs ]),
+    aeb_fate_code:update_symbols(FateCode, Symbols).
+
+functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Options) ->
     FunNames = maps:keys(Functions),
     maps:from_list(
-        [ {make_function_name(Name), function_to_scode(ChildContracts, ContractName, FunNames, Name, Attrs, Args, Body, Type, Options)}
+        [ {make_function_name(Name), function_to_scode(ChildContracts, ContractName, FunNames, Name, Attrs, Args, Body, Type, SavedFreshNames, Options)}
         || {Name, #{args   := Args,
                     body   := Body,
                     attrs  := Attrs,
                     return := Type}} <- maps:to_list(Functions)]).
 
-function_to_scode(ChildContracts, ContractName, Functions, Name, Attrs0, Args, Body, ResType, Options) ->
+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.
-    Env = init_env(ChildContracts, ContractName, Functions, Name, Args, Options),
+    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 ],
     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}).
+
 -define(tvars, '$tvars').
 
 typesig_to_scode(Args, Res) ->
@@ -147,19 +193,21 @@ types_to_scode(Ts) -> lists:map(fun type_to_scode/1, Ts).
 
 %% -- Environment functions --
 
-init_env(ChildContracts, ContractName, FunNames, Name, Args, Options) ->
+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 }.
+          tailpos   = true,
+          saved_fresh_names = SavedFreshNames }.
 
 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) ->
@@ -183,9 +231,10 @@ serialize_contract_code(Env, C) ->
             end,
     case maps:get(C, Cache, none) of
         none ->
-            Options  = Env#env.options,
-            FCode    = maps:get(C, Env#env.child_contracts),
-            FateCode = compile(Env#env.child_contracts, FCode, Options),
+            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),
             ByteCode = aeb_fate_code:serialize(FateCode, []),
             {ok, Version} = aeso_compiler:version(),
             OriginalSourceCode = proplists:get_value(original_src, Options, ""),
@@ -507,6 +556,8 @@ builtin_to_scode(Env, bytes_split, [_, _] = Args) ->
     call_to_scode(Env, aeb_fate_ops:bytes_split(?a, ?a, ?a), Args);
 builtin_to_scode(Env, abort, [_] = Args) ->
     call_to_scode(Env, aeb_fate_ops:abort(?a), Args);
+builtin_to_scode(Env, exit, [_] = Args) ->
+    call_to_scode(Env, aeb_fate_ops:exit(?a), Args);
 builtin_to_scode(Env, chain_spend, [_, _] = Args) ->
     call_to_scode(Env, [aeb_fate_ops:spend(?a, ?a),
                         tuple(0)], Args);
@@ -705,7 +756,7 @@ tuple(N) -> aeb_fate_ops:tuple(?a, N).
 
 optimize_scode(Funs, Options) ->
     maps:map(fun(Name, Def) -> optimize_fun(Funs, Name, Def, Options) end,
-             Funs).
+            Funs).
 
 flatten(missing) -> missing;
 flatten(Code)    -> lists:map(fun flatten_s/1, lists:flatten(Code)).
@@ -1088,7 +1139,8 @@ simpl_top(I, Code, Options) ->
 simpl_top(0, I, Code, _Options) ->
     code_error({optimizer_out_of_fuel, I, Code});
 simpl_top(Fuel, I, Code, Options) ->
-    apply_rules(Fuel, rules(), I, Code, Options).
+    Rules = [R || R = {Rule, _} <- rules(), proplists:get_value(Rule, Options, true)],
+    apply_rules(Fuel, Rules, I, Code, Options).
 
 apply_rules(Fuel, Rules, I, Code, Options) ->
     Cons = fun(X, Xs) -> simpl_top(Fuel - 1, X, Xs, Options) end,
@@ -1115,29 +1167,29 @@ apply_rules_once([{RName, Rule} | Rules], I, Code) ->
 -define(RULE(Name), {Name, fun Name/2}).
 
 merge_rules() ->
-    [?RULE(r_push_consume),
-     ?RULE(r_one_shot_var),
-     ?RULE(r_write_to_dead_var),
-     ?RULE(r_inline_switch_target)
+    [?RULE(optimize_push_consume),
+     ?RULE(optimize_one_shot_var),
+     ?RULE(optimize_write_to_dead_var),
+     ?RULE(optimize_inline_switch_target)
     ].
 
 rules() ->
     merge_rules() ++
-    [?RULE(r_swap_push),
-     ?RULE(r_swap_pop),
-     ?RULE(r_swap_write),
-     ?RULE(r_constant_propagation),
-     ?RULE(r_prune_impossible_branches),
-     ?RULE(r_single_successful_branch),
-     ?RULE(r_inline_store),
-     ?RULE(r_float_switch_body)
+    [?RULE(optimize_swap_push),
+     ?RULE(optimize_swap_pop),
+     ?RULE(optimize_swap_write),
+     ?RULE(optimize_constant_propagation),
+     ?RULE(optimize_prune_impossible_branches),
+     ?RULE(optimize_single_successful_branch),
+     ?RULE(optimize_inline_store),
+     ?RULE(optimize_float_switch_body)
     ].
 
 %% Removing pushes that are immediately consumed.
-r_push_consume({i, Ann1, {'STORE', ?a, A}}, Code) ->
+optimize_push_consume({i, Ann1, {'STORE', ?a, A}}, Code) ->
     inline_push(Ann1, A, 0, Code, []);
 %% Writing directly to memory instead of going through the accumulator.
-r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) ->
+optimize_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) ->
     IsPush =
         case op_view(I) of
             {_, ?a, _} -> true;
@@ -1149,7 +1201,7 @@ r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) ->
         end,
     if IsPush -> {[{i, merge_ann(Ann1, Ann2), setelement(2, I, R)}], Code};
        true   -> false end;
-r_push_consume(_, _) -> false.
+optimize_push_consume(_, _) -> false.
 
 inline_push(Ann, Arg, Stack, [{i, _, switch_body} = AI | Code], Acc) ->
     {AI1, {i, Ann1, _}} = swap_instrs({i, Ann, {'STORE', ?a, Arg}}, AI),
@@ -1182,7 +1234,7 @@ split_stack_arg(N, [A | As], Acc) ->
     split_stack_arg(N1, As, [A | Acc]).
 
 %% Move PUSHes past non-stack instructions.
-r_swap_push(Push = {i, _, PushI}, [I | Code]) ->
+optimize_swap_push(Push = {i, _, PushI}, [I | Code]) ->
     case op_view(PushI) of
         {_, ?a, _} ->
             case independent(Push, I) of
@@ -1193,10 +1245,10 @@ r_swap_push(Push = {i, _, PushI}, [I | Code]) ->
             end;
         _ -> false
     end;
-r_swap_push(_, _) -> false.
+optimize_swap_push(_, _) -> false.
 
 %% Move non-stack instruction past POPs.
-r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
+optimize_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
     case independent(IA, JA) of
         true ->
             case {op_view(I), op_view(J)} of
@@ -1204,7 +1256,7 @@ r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
                 {_, false} -> false;
                 {{_, IR, IAs}, {_, RJ, JAs}} ->
                     NonStackI = not lists:member(?a, [IR | IAs]),
-                    %% RJ /= ?a to not conflict with r_swap_push
+                    %% RJ /= ?a to not conflict with optimize_swap_push
                     PopJ      = RJ /= ?a andalso lists:member(?a, JAs),
                     case NonStackI andalso PopJ of
                         false -> false;
@@ -1215,22 +1267,22 @@ r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
             end;
         false -> false
     end;
-r_swap_pop(_, _) -> false.
+optimize_swap_pop(_, _) -> false.
 
 %% Match up writes to variables with instructions further down.
-r_swap_write(I = {i, _, _}, [J | Code]) ->
+optimize_swap_write(I = {i, _, _}, [J | Code]) ->
     case {var_writes(I), independent(I, J)} of
         {[_], true} ->
             {J1, I1} = swap_instrs(I, J),
-            r_swap_write([J1], I1, Code);
+            optimize_swap_write([J1], I1, Code);
         _ -> false
     end;
-r_swap_write(_, _) -> false.
+optimize_swap_write(_, _) -> false.
 
-r_swap_write(Pre, I, [{i, _, switch_body} = J | Code]) ->
+optimize_swap_write(Pre, I, [{i, _, switch_body} = J | Code]) ->
     {J1, I1} = swap_instrs(I, J),
-    r_swap_write([J1 | Pre], I1, Code);
-r_swap_write(Pre, I, Code0 = [J | Code]) ->
+    optimize_swap_write([J1 | Pre], I1, Code);
+optimize_swap_write(Pre, I, Code0 = [J | Code]) ->
     case apply_rules_once(merge_rules(), I, Code0) of
         {_Rule, New, Rest} ->
             {lists:reverse(Pre) ++ New, Rest};
@@ -1239,27 +1291,27 @@ r_swap_write(Pre, I, Code0 = [J | Code]) ->
                 false -> false;
                 true  ->
                     {J1, I1} = swap_instrs(I, J),
-                    r_swap_write([J1 | Pre], I1, Code)
+                    optimize_swap_write([J1 | Pre], I1, Code)
             end
     end;
-r_swap_write(_, _, _) -> false.
+optimize_swap_write(_, _, _) -> false.
 
 %% Precompute instructions with known values
-r_constant_propagation(Cons = {i, Ann1, {'CONS', R, X, Xs}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
+optimize_constant_propagation(Cons = {i, Ann1, {'CONS', R, X, Xs}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
     Store = {i, Ann, {'STORE', S, ?i(false)}},
     Cons1 = case R of
                 ?a -> {i, Ann1, {'CONS', ?void, X, Xs}};
                 _  -> Cons
             end,
     {[Cons1, Store], Code};
-r_constant_propagation(Nil = {i, Ann1, {'NIL', R}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
+optimize_constant_propagation(Nil = {i, Ann1, {'NIL', R}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
     Store = {i, Ann, {'STORE', S, ?i(true)}},
     Nil1 = case R of
                ?a -> {i, Ann1, {'NIL', ?void}};
                _  -> Nil
            end,
     {[Nil1, Store], Code};
-r_constant_propagation({i, Ann, I}, Code) ->
+optimize_constant_propagation({i, Ann, I}, Code) ->
     case op_view(I) of
         false -> false;
         {Op, R, As} ->
@@ -1273,7 +1325,7 @@ r_constant_propagation({i, Ann, I}, Code) ->
                     end
             end
     end;
-r_constant_propagation(_, _) -> false.
+optimize_constant_propagation(_, _) -> false.
 
 eval_op('ADD', [X, Y]) when is_integer(X), is_integer(Y) -> X + Y;
 eval_op('SUB', [X, Y]) when is_integer(X), is_integer(Y) -> X - Y;
@@ -1292,12 +1344,12 @@ eval_op('NOT', [false]) -> true;
 eval_op(_, _)           -> no_eval.   %% TODO: bits?
 
 %% Prune impossible branches from switches
-r_prune_impossible_branches({switch, ?i(V), Type, Alts, missing}, Code) ->
+optimize_prune_impossible_branches({switch, ?i(V), Type, Alts, missing}, Code) ->
     case pick_branch(Type, V, Alts) of
         false -> false;
         Alt   -> {Alt, Code}
     end;
-r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, Code) when V == true; V == false ->
+optimize_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, Code) when V == true; V == false ->
     Alts1 = [if V -> missing; true -> False   end,
              if V -> True;    true -> missing end],
     case Alts == Alts1 of
@@ -1308,7 +1360,7 @@ r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def},
                 _                  -> {[{switch, ?i(V), boolean, Alts1, Def}], Code}
             end
     end;
-r_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_)}},
+optimize_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_)}},
                             [{switch, R, Type = {variant, _}, Alts, missing} | Code]) when is_integer(Tag) ->
     case {R, lists:nth(Tag + 1, Alts)} of
         {_, missing} ->
@@ -1324,7 +1376,7 @@ r_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_
                 false -> {Alt, Code}
             end
     end;
-r_prune_impossible_branches(_, _) -> false.
+optimize_prune_impossible_branches(_, _) -> false.
 
 pick_branch(boolean, V, [False, True]) when V == true; V == false ->
     Alt = if V -> True; true -> False end,
@@ -1337,7 +1389,7 @@ pick_branch(_Type, _V, _Alts) ->
 
 %% If there's a single branch that doesn't abort we can push the code for that
 %% out of the switch.
-r_single_successful_branch({switch, R, Type, Alts, Def}, Code) ->
+optimize_single_successful_branch({switch, R, Type, Alts, Def}, Code) ->
     case push_code_out_of_switch([Def | Alts]) of
         {_, none} -> false;
         {_, many} -> false;
@@ -1345,7 +1397,7 @@ r_single_successful_branch({switch, R, Type, Alts, Def}, Code) ->
         {[Def1 | Alts1], PushedOut} ->
             {[{switch, R, Type, Alts1, Def1} | PushedOut], Code}
     end;
-r_single_successful_branch(_, _) -> false.
+optimize_single_successful_branch(_, _) -> false.
 
 push_code_out_of_switch([]) -> {[], none};
 push_code_out_of_switch([Alt | Alts]) ->
@@ -1381,7 +1433,7 @@ does_abort({switch, _, _, Alts, Def}) ->
 does_abort(_) -> false.
 
 %% STORE R A, SWITCH R --> SWITCH A
-r_inline_switch_target({i, Ann, {'STORE', R, A}}, [{switch, R, Type, Alts, Def} | Code]) ->
+optimize_inline_switch_target({i, Ann, {'STORE', R, A}}, [{switch, R, Type, Alts, Def} | Code]) ->
     Ann1   =
         case is_reg(A) of
             true  -> Ann#{ live_out := ordsets:add_element(A, maps:get(live_out, Ann)) };
@@ -1400,18 +1452,18 @@ r_inline_switch_target({i, Ann, {'STORE', R, A}}, [{switch, R, Type, Alts, Def}
             end;
         _        -> false %% impossible
     end;
-r_inline_switch_target(_, _) -> false.
+optimize_inline_switch_target(_, _) -> false.
 
 %% Float switch-body to closest switch
-r_float_switch_body(I = {i, _, _}, [J = {i, _, switch_body} | Code]) ->
+optimize_float_switch_body(I = {i, _, _}, [J = {i, _, switch_body} | Code]) ->
     {J1, I1} = swap_instrs(I, J),
     {[], [J1, I1 | Code]};
-r_float_switch_body(_, _) -> false.
+optimize_float_switch_body(_, _) -> false.
 
 %% Inline stores
-r_inline_store({i, _, {'STORE', R, R}}, Code) ->
+optimize_inline_store({i, _, {'STORE', R, R}}, Code) ->
     {[], Code};
-r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
+optimize_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
     %% Not when A is var unless updating the annotations properly.
     Inline = case A of
                  {arg, _}   -> true;
@@ -1419,13 +1471,13 @@ r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
                  {store, _} -> true;
                  _          -> false
              end,
-    if Inline -> r_inline_store([I], false, R, A, Code);
+    if Inline -> optimize_inline_store([I], false, R, A, Code);
        true   -> false end;
-r_inline_store(_, _) -> false.
+optimize_inline_store(_, _) -> false.
 
-r_inline_store(Acc, Progress, R, A, [I = {i, _, switch_body} | Code]) ->
-    r_inline_store([I | Acc], Progress, R, A, Code);
-r_inline_store(Acc, Progress, R, A, [{i, Ann, I} | Code]) ->
+optimize_inline_store(Acc, Progress, R, A, [I = {i, _, switch_body} | Code]) ->
+    optimize_inline_store([I | Acc], Progress, R, A, Code);
+optimize_inline_store(Acc, Progress, R, A, [{i, Ann, I} | Code]) ->
     #{ write := W } = attributes(I),
     Inl = fun(X) when X == R -> A; (X) -> X end,
     case live_in(R, Ann) of
@@ -1445,14 +1497,14 @@ r_inline_store(Acc, Progress, R, A, [{i, Ann, I} | Code]) ->
             case lists:member(W, [R, A]) of
                 true when Progress1 -> {lists:reverse(Acc1), Code};
                 true                -> false;
-                false               -> r_inline_store(Acc1, Progress1, R, A, Code)
+                false               -> optimize_inline_store(Acc1, Progress1, R, A, Code)
             end
     end;
-r_inline_store(Acc, true, _, _, Code) -> {lists:reverse(Acc), Code};
-r_inline_store(_, false, _, _, _) -> false.
+optimize_inline_store(Acc, true, _, _, Code) -> {lists:reverse(Acc), Code};
+optimize_inline_store(_, false, _, _, _) -> false.
 
 %% Shortcut write followed by final read
-r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
+optimize_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
     case op_view(I) of
         {Op, R = {var, _}, As} ->
             Copy = case J of
@@ -1466,11 +1518,11 @@ r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
             end;
         _ -> false
     end;
-r_one_shot_var(_, _) -> false.
+optimize_one_shot_var(_, _) -> false.
 
 %% Remove writes to dead variables
-r_write_to_dead_var({i, _, {'STORE', ?void, ?a}}, _) -> false; %% Avoid looping
-r_write_to_dead_var({i, Ann, I}, Code) ->
+optimize_write_to_dead_var({i, _, {'STORE', ?void, ?a}}, _) -> false; %% Avoid looping
+optimize_write_to_dead_var({i, Ann, I}, Code) ->
     #{ pure := Pure } = attributes(I),
     case op_view(I) of
         {_Op, R, As} when R /= ?a, Pure ->
@@ -1483,9 +1535,10 @@ r_write_to_dead_var({i, Ann, I}, Code) ->
             end;
         _ -> false
     end;
-r_write_to_dead_var(_, _) -> false.
+optimize_write_to_dead_var(_, _) -> false.
 
 op_view({'ABORT', R}) -> {'ABORT', none, [R]};
+op_view({'EXIT', R}) -> {'EXIT', none, [R]};
 op_view(T) when is_tuple(T) ->
     [Op, R | As] = tuple_to_list(T),
     CheckReads = fun(Rs, X) -> case [] == Rs -- [dst, src] of true -> X; false -> false end end,

src/aeso_parser.erl

@@ -96,17 +96,29 @@ decl() ->
     choice(
       %% Contract declaration
     [ ?RULE(token(main), keyword(contract),
-            con(), tok('='), maybe_block(decl()), {contract_main, _2, _3, _5})
+            con(), tok('='), maybe_block(decl()), {contract_main, _2, _3, [], _5})
+    , ?RULE(token(main), keyword(contract),
+            con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), {contract_main, _2, _3, _5, _7})
     , ?RULE(keyword(contract),
-            con(), tok('='), maybe_block(decl()), {contract_child, _1, _2, _4})
+            con(), tok('='), maybe_block(decl()), {contract_child, _1, _2, [], _4})
+    , ?RULE(keyword(contract),
+            con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), {contract_child, _1, _2, _4, _6})
     , ?RULE(keyword(contract), token(interface),
-            con(), tok('='), maybe_block(decl()), {contract_interface, _1, _3, _5})
+            con(), tok('='), maybe_block(decl()), {contract_interface, _1, _3, [], _5})
+    , ?RULE(keyword(contract), token(interface),
+            con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), {contract_interface, _1, _3, _5, _7})
     , ?RULE(token(payable), token(main), keyword(contract),
-            con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_main, _3, _4, _6}))
+            con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_main, _3, _4, [], _6}))
+    , ?RULE(token(payable), token(main), keyword(contract),
+            con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_main, _3, _4, _6, _8}))
     , ?RULE(token(payable), keyword(contract),
-            con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_child, _2, _3, _5}))
+            con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_child, _2, _3, [], _5}))
+    , ?RULE(token(payable), keyword(contract),
+            con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_child, _2, _3, _5, _7}))
     , ?RULE(token(payable), keyword(contract), token(interface),
-            con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_interface, _2, _4, _6}))
+            con(), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_interface, _2, _4, [], _6}))
+    , ?RULE(token(payable), keyword(contract), token(interface),
+            con(), tok(':'), comma_sep(con()), tok('='), maybe_block(decl()), add_modifiers([_1], {contract_interface, _2, _4, _6, _8}))
 
 
     , ?RULE(keyword(namespace), con(), tok('='), maybe_block(decl()), {namespace, _1, _2, _4})
@@ -347,9 +359,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()

src/aeso_pretty.erl

@@ -151,12 +151,16 @@ decl(D, Options) ->
     with_options(Options, fun() -> decl(D) end).
 
 -spec decl(aeso_syntax:decl()) -> doc().
-decl({Con, Attrs, C, Ds}) when ?IS_CONTRACT_HEAD(Con) ->
+decl({Con, Attrs, C, Is, Ds}) when ?IS_CONTRACT_HEAD(Con) ->
     Mod = fun({Mod, true}) when Mod == payable ->
                   text(atom_to_list(Mod));
              (_) -> empty() end,
+    ImplsList = case Is of
+                    [] -> [empty()];
+                    _  -> [text(":"), par(punctuate(text(","), lists:map(fun name/1, Is)), 0)]
+                end,
     block(follow( hsep(lists:map(Mod, Attrs) ++ [contract_head(Con)])
-                , hsep(name(C), text("="))), decls(Ds));
+                , hsep([name(C)] ++ ImplsList ++ [text("=")])), decls(Ds));
 decl({namespace, _, C, Ds}) ->
     block(follow(text("namespace"), hsep(name(C), text("="))), decls(Ds));
 decl({pragma, _, Pragma}) -> pragma(Pragma);
@@ -257,6 +261,8 @@ type(Type, Options) ->
     with_options(Options, fun() -> type(Type) end).
 
 -spec type(aeso_syntax:type()) -> doc().
+type(F = {fun_t, _, _, var_args, _}) ->
+    type(setelement(4, F, [var_args]));
 type({fun_t, _, Named, Args, Ret}) ->
     follow(hsep(args_type(Named ++ Args), text("=>")), type(Ret));
 type({type_sig, _, Named, Args, Ret}) ->
@@ -284,7 +290,9 @@ type(T = {id, _, _})   -> name(T);
 type(T = {qid, _, _})  -> name(T);
 type(T = {con, _, _})  -> name(T);
 type(T = {qcon, _, _}) -> name(T);
-type(T = {tvar, _, _}) -> name(T).
+type(T = {tvar, _, _}) -> name(T);
+
+type(var_args) -> text("var_args").
 
 -spec args_type([aeso_syntax:type()]) -> doc().
 args_type(Args) ->
@@ -426,6 +434,7 @@ lc_bind(Let) ->
 bin_prec('..')   -> {  0,   0,   0};  %% Always printed inside '[ ]'
 bin_prec('=')    -> {  0,   0,   0};  %% Always printed inside '[ ]'
 bin_prec('@')    -> {  0,   0,   0};  %% Only in error messages
+bin_prec('|>')   -> {150, 150, 200};
 bin_prec('||')   -> {200, 300, 200};
 bin_prec('&&')   -> {300, 400, 300};
 bin_prec('<')    -> {400, 500, 500};

src/aeso_syntax.erl

@@ -13,7 +13,7 @@
 -export_type([ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
 -export_type([name/0, id/0, con/0, qid/0, qcon/0, tvar/0, op/0]).
 -export_type([bin_op/0, un_op/0]).
--export_type([decl/0, letbind/0, typedef/0, pragma/0]).
+-export_type([decl/0, letbind/0, typedef/0, pragma/0, fundecl/0]).
 -export_type([arg/0, field_t/0, constructor_t/0, named_arg_t/0]).
 -export_type([type/0, constant/0, expr/0, arg_expr/0, field/1, stmt/0, alt/0, lvalue/0, elim/0, pat/0]).
 -export_type([ast/0]).
@@ -26,7 +26,7 @@
 -type ann_format() :: '?:' | hex | infix | prefix | elif.
 
 -type ann() :: [ {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()}
-               | stateful | private | payable | main | interface].
+               | stateful | private | payable | main | interface | entrypoint].
 
 -type name() :: string().
 -type id()   :: {id,   ann(), name()}.
@@ -38,10 +38,11 @@
 -type namespace_alias() :: none | con().
 -type namespace_parts() :: none | {for, [id()]} | {hiding, [id()]}.
 
--type decl() :: {contract_main, ann(), con(), [decl()]}
-              | {contract_child, ann(), con(), [decl()]}
-              | {contract_interface, ann(), con(), [decl()]}
+-type decl() :: {contract_main, ann(), con(), [con()], [decl()]}
+              | {contract_child, ann(), con(), [con()], [decl()]}
+              | {contract_interface, ann(), con(), [con()], [decl()]}
               | {namespace, ann(), con(), [decl()]}
+              | {include, ann(), {string, ann(), string()}}
               | {pragma, ann(), pragma()}
               | {type_decl, ann(), id(), [tvar()]} % Only for error msgs
               | {type_def, ann(), id(), [tvar()], typedef()}
@@ -105,7 +106,7 @@
 
 -type bin_op() :: '+' | '-' | '*' | '/' | mod | '^'
                 | '++' | '::' | '<' | '>' | '=<' | '>=' | '==' | '!='
-                | '||' | '&&' | '..'.
+                | '||' | '&&' | '..' | '|>'.
 -type un_op() :: '-' | '!'.
 
 -type expr()

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).
-

src/aeso_tc_ann_manip.erl

@@ -0,0 +1,17 @@
+-module(aeso_tc_ann_manip).
+
+-export([ pos/1
+        , pos/2
+        , loc/1
+        ]).
+
+src_file(T)      -> aeso_syntax:get_ann(file, T, no_file).
+include_type(T)  -> aeso_syntax:get_ann(include_type, T, none).
+line_number(T)   -> aeso_syntax:get_ann(line, T, 0).
+column_number(T) -> aeso_syntax:get_ann(col, T, 0).
+
+pos(T)    -> aeso_errors:pos(src_file(T), line_number(T), column_number(T)).
+pos(L, C) -> aeso_errors:pos(L, C).
+
+loc(T) ->
+    {src_file(T), include_type(T), line_number(T), column_number(T)}.

src/aeso_tc_constraints.erl

@@ -0,0 +1,593 @@
+-module(aeso_tc_constraints).
+
+-export([ solve_constraints/1
+        , solve_then_destroy_and_report_unsolved_constraints/1
+        , create_constraints/0
+        , add_is_contract_constraint/2
+        , add_is_contract_constraint/3
+        , add_aens_resolve_constraint/1
+        , add_oracle_type_constraint/2
+        , add_named_argument_constraint/3
+        , add_field_constraint/5
+        , add_dependent_type_constraint/5
+        , add_record_create_constraint/3
+        , freshen_type/2
+        , freshen_type_sig/2
+        ]).
+
+%% -- Duplicated types -------------------------------------------------------
+
+-type uvar() :: {uvar, aeso_syntax:ann(), reference()}.
+-type named_args_t() :: uvar() | [{named_arg_t, aeso_syntax:ann(), aeso_syntax:id(), utype(), aeso_syntax:expr()}].
+-type utype() :: aeso_tc_typedefs:utype().
+
+%% -- Duplicated macros ------------------------------------------------------
+
+-define(is_type_id(T), element(1, T) =:= id orelse
+                       element(1, T) =:= qid orelse
+                       element(1, T) =:= con orelse
+                       element(1, T) =:= qcon).
+
+%% -- Moved functions --------------------------------------------------------
+
+unify(A, B, C, D) -> aeso_tc_unify:unify(A, B, C, D).
+
+%% -------
+
+unfold_types_in_type(A, B) -> aeso_tc_type_unfolding:unfold_types_in_type(A, B).
+
+%% -------
+
+qname(A) -> aeso_tc_name_manip:qname(A).
+
+%% -------
+
+type_error(A) -> aeso_tc_errors:type_error(A).
+
+%% -------
+
+is_monomorphic(A) -> aeso_tc_type_utils:is_monomorphic(A).
+is_first_order(A) -> aeso_tc_type_utils:is_first_order(A).
+app_t(A, B, C) -> aeso_tc_type_utils:app_t(A, B, C).
+fresh_uvar(A) -> aeso_tc_type_utils:fresh_uvar(A).
+
+%% ---------------------------------------------------------------------------
+
+-type env() :: aeso_tc_env:env().
+
+-type why_record() :: aeso_syntax:field(aeso_syntax:expr())
+                    | {var_args, aeso_syntax:ann(), aeso_syntax:expr()}
+                    | {proj, aeso_syntax:ann(), aeso_syntax:expr(), aeso_syntax:id()}.
+
+-record(named_argument_constraint,
+    {args :: named_args_t(),
+     name :: aeso_syntax:id(),
+     type :: utype()}).
+
+-record(dependent_type_constraint,
+    { named_args_t     :: named_args_t()
+    , named_args       :: [aeso_syntax:arg_expr()]
+    , general_type     :: utype()
+    , specialized_type :: utype()
+    , context          :: term() }).
+
+-type named_argument_constraint() :: #named_argument_constraint{} | #dependent_type_constraint{}.
+
+-record(field_constraint,
+    { record_t :: utype()
+    , field    :: aeso_syntax:id()
+    , field_t  :: utype()
+    , kind     :: project | create | update %% Projection constraints can match contract
+    , context  :: why_record() }).          %% types, but field constraints only record types.
+
+%% Constraint checking that 'record_t' has precisely 'fields'.
+-record(record_create_constraint,
+    { record_t :: utype()
+    , fields   :: [aeso_syntax:id()]
+    , context  :: why_record() }).
+
+-record(is_contract_constraint,
+    { contract_t :: utype(),
+      context    :: {contract_literal, aeso_syntax:expr()} |
+                    {address_to_contract, aeso_syntax:ann()} |
+                    {bytecode_hash, aeso_syntax:ann()} |
+                    {var_args, aeso_syntax:ann(), aeso_syntax:expr()},
+      force_def = false :: boolean()
+    }).
+
+-type field_constraint() :: #field_constraint{} | #record_create_constraint{} | #is_contract_constraint{}.
+
+-type byte_constraint() :: {is_bytes, utype()}
+                         | {add_bytes, aeso_syntax:ann(), concat | split, utype(), utype(), utype()}.
+
+-type aens_resolve_constraint() :: {aens_resolve_type, utype()}.
+-type oracle_type_constraint() :: {oracle_type, aeso_syntax:ann(), utype()}.
+
+-type constraint() :: named_argument_constraint() | field_constraint() | byte_constraint()
+                    | aens_resolve_constraint() | oracle_type_constraint().
+
+-spec add_constraint(constraint()) -> true.
+add_constraint(Constraint) ->
+    aeso_tc_ets_manager:ets_insert_ordered(constraints, Constraint).
+
+add_is_contract_constraint(ContractT, Context) ->
+    add_constraint(
+        #is_contract_constraint{
+            contract_t = ContractT,
+            context    = Context }).
+
+add_is_contract_constraint(ContractT, Context, ForceDef) ->
+    add_constraint(
+        #is_contract_constraint{
+            contract_t = ContractT,
+            context    = Context,
+            force_def  = ForceDef }).
+
+add_aens_resolve_constraint(Type) ->
+    add_constraint({aens_resolve_type, Type}).
+
+add_oracle_type_constraint(Ann, Type) ->
+    add_constraint({oracle_type, Ann, Type}).
+
+add_named_argument_constraint(Args, Name, Type) ->
+    add_constraint(
+        #named_argument_constraint{
+            args = Args,
+            name = Name,
+            type = Type }).
+
+add_field_constraint(RecordT, Field, FieldT, Kind, Context) ->
+    add_constraint(#field_constraint{
+        record_t = RecordT,
+        field    = Field,
+        field_t  = FieldT,
+        kind     = Kind,
+        context  = Context }).
+
+add_dependent_type_constraint(NamedArgsT, NamedArgs, GeneralType, SpecializedType, Context) ->
+    add_constraint(#dependent_type_constraint{
+        named_args_t     = NamedArgsT,
+        named_args       = NamedArgs,
+        general_type     = GeneralType,
+        specialized_type = SpecializedType,
+        context          = Context }).
+
+add_record_create_constraint(RecordT, Fields, Context) ->
+    add_constraint(#record_create_constraint{
+        record_t = RecordT,
+        fields   = Fields,
+        context  = Context }).
+
+create_constraints() ->
+    aeso_tc_ets_manager:ets_new(constraints, [ordered_set]).
+
+get_constraints() ->
+    aeso_tc_ets_manager:ets_tab2list_ordered(constraints).
+
+destroy_constraints() ->
+    aeso_tc_ets_manager:ets_delete(constraints).
+
+-spec solve_constraints(env()) -> ok.
+solve_constraints(Env) ->
+    %% First look for record fields that appear in only one type definition
+    IsAmbiguous =
+        fun(#field_constraint{
+               record_t = RecordType,
+               field    = Field={id, _Attrs, FieldName},
+               field_t  = FieldType,
+               kind     = Kind,
+               context  = When }) ->
+                Arity = aeso_tc_type_utils:fun_arity(aeso_tc_type_utils:dereference_deep(FieldType)),
+                FieldInfos = case Arity of
+                                 none -> aeso_tc_env:lookup_record_field(Env, FieldName, Kind);
+                                 _    -> aeso_tc_env:lookup_record_field_arity(Env, FieldName, Arity, Kind)
+                             end,
+                case FieldInfos of
+                    [] ->
+                        type_error({undefined_field, Field}),
+                        false;
+                    [Fld] ->
+                        FldType = aeso_tc_env:field_info_field_t(Fld),
+                        RecType = aeso_tc_env:field_info_record_t(Fld),
+                        create_freshen_tvars(),
+                        FreshFldType = freshen(FldType),
+                        FreshRecType = freshen(RecType),
+                        destroy_freshen_tvars(),
+                        unify(Env, FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}),
+                        unify(Env, FreshRecType, RecordType, {record_constraint, FreshRecType, RecordType, When}),
+                        false;
+                    _ ->
+                        %% ambiguity--need cleverer strategy
+                        true
+                end;
+           (_) -> true
+        end,
+    AmbiguousConstraints = lists:filter(IsAmbiguous, get_constraints()),
+
+    % The two passes on AmbiguousConstraints are needed
+    solve_ambiguous_constraints(Env, AmbiguousConstraints ++ AmbiguousConstraints).
+
+-spec solve_ambiguous_constraints(env(), [constraint()]) -> ok.
+solve_ambiguous_constraints(Env, Constraints) ->
+    Unknown = solve_known_record_types(Env, Constraints),
+    if Unknown == [] -> ok;
+       length(Unknown) < length(Constraints) ->
+            %% progress! Keep trying.
+            solve_ambiguous_constraints(Env, Unknown);
+       true ->
+            case solve_unknown_record_types(Env, Unknown) of
+                true -> %% Progress!
+                    solve_ambiguous_constraints(Env, Unknown);
+                _ -> ok %% No progress. Report errors later.
+            end
+    end.
+
+solve_then_destroy_and_report_unsolved_constraints(Env) ->
+    solve_constraints(Env),
+    destroy_and_report_unsolved_constraints(Env).
+
+destroy_and_report_unsolved_constraints(Env) ->
+    {FieldCs, OtherCs} =
+        lists:partition(fun(#field_constraint{}) -> true; (_) -> false end,
+                        get_constraints()),
+    {CreateCs, OtherCs1} =
+        lists:partition(fun(#record_create_constraint{}) -> true; (_) -> false end,
+                        OtherCs),
+    {ContractCs, OtherCs2} =
+        lists:partition(fun(#is_contract_constraint{}) -> true; (_) -> false end, OtherCs1),
+    {NamedArgCs, OtherCs3} =
+        lists:partition(fun(#dependent_type_constraint{}) -> true;
+                           (#named_argument_constraint{}) -> true;
+                           (_)                            -> false
+                        end, OtherCs2),
+    {BytesCs, OtherCs4} =
+        lists:partition(fun({is_bytes, _})              -> true;
+                           ({add_bytes, _, _, _, _, _}) -> true;
+                           (_)                          -> false
+                        end, OtherCs3),
+    {AensResolveCs, OtherCs5} =
+        lists:partition(fun({aens_resolve_type, _}) -> true;
+                           (_)                      -> false
+                        end, OtherCs4),
+    {OracleTypeCs, []} =
+        lists:partition(fun({oracle_type, _, _}) -> true;
+                           (_)                   -> false
+                        end, OtherCs5),
+
+    Unsolved = [ S || S <- [ solve_constraint(Env, aeso_tc_type_utils:dereference_deep(C)) || C <- NamedArgCs ],
+                      S == unsolved ],
+    [ type_error({unsolved_named_argument_constraint, Name, Type})
+        || #named_argument_constraint{name = Name, type = Type} <- Unsolved ],
+
+    Unknown = solve_known_record_types(Env, FieldCs),
+    if Unknown == [] -> ok;
+       true ->
+            case solve_unknown_record_types(Env, Unknown) of
+                true   -> ok;
+                Errors -> [ type_error(Err) || Err <- Errors ]
+            end
+    end,
+
+    check_record_create_constraints(Env, CreateCs),
+    check_is_contract_constraints(Env, ContractCs),
+    check_bytes_constraints(Env, BytesCs),
+    check_aens_resolve_constraints(Env, AensResolveCs),
+    check_oracle_type_constraints(Env, OracleTypeCs),
+
+    destroy_constraints().
+
+%% If false, a type error has been emitted, so it's safe to drop the constraint.
+-spec check_named_argument_constraint(env(), named_argument_constraint()) -> true | false | unsolved.
+check_named_argument_constraint(_Env, #named_argument_constraint{ args = {uvar, _, _} }) ->
+    unsolved;
+check_named_argument_constraint(Env,
+    #named_argument_constraint{ args = Args,
+                                name = Id = {id, _, Name},
+                                type = Type }) ->
+    case [ T || {named_arg_t, _, {id, _, Name1}, T, _} <- Args, Name1 == Name ] of
+        []  ->
+            type_error({bad_named_argument, Args, Id}),
+            false;
+        [T] -> unify(Env, T, Type, {check_named_arg_constraint, Args, Id, Type}), true
+    end;
+check_named_argument_constraint(Env,
+        #dependent_type_constraint{ named_args_t = NamedArgsT0,
+                                    named_args = NamedArgs,
+                                    general_type = GenType,
+                                    specialized_type = SpecType,
+                                    context = {check_return, App} }) ->
+    NamedArgsT = aeso_tc_type_utils:dereference(NamedArgsT0),
+    case aeso_tc_type_utils:dereference(NamedArgsT0) of
+        [_ | _] = NamedArgsT ->
+            GetVal = fun(Name, Default) ->
+                        hd([ Val || {named_arg, _, {id, _, N}, Val} <- NamedArgs, N == Name] ++
+                           [ Default ])
+                     end,
+            ArgEnv = maps:from_list([ {Name, GetVal(Name, Default)}
+                                      || {named_arg_t, _, {id, _, Name}, _, Default} <- NamedArgsT ]),
+            GenType1 = specialize_dependent_type(ArgEnv, GenType),
+            unify(Env, GenType1, SpecType, {check_expr, App, GenType1, SpecType}),
+            true;
+        _ -> unify(Env, GenType, SpecType, {check_expr, App, GenType, SpecType}), true
+    end.
+
+specialize_dependent_type(Env, Type) ->
+    case aeso_tc_type_utils:dereference(Type) of
+        {if_t, _, {id, _, Arg}, Then, Else} ->
+            Val = maps:get(Arg, Env),
+            case Val of
+                {typed, _, {bool, _, true}, _}  -> Then;
+                {typed, _, {bool, _, false}, _} -> Else;
+                _ ->
+                    type_error({named_argument_must_be_literal_bool, Arg, Val}),
+                    fresh_uvar(aeso_syntax:get_ann(Val))
+            end;
+        _ -> Type   %% Currently no deep dependent types
+    end.
+
+%% -- Bytes constraints --
+
+solve_constraint(_Env, #field_constraint{record_t = {uvar, _, _}}) ->
+    not_solved;
+solve_constraint(Env, C = #field_constraint{record_t = RecType,
+                                            field    = FieldName,
+                                            field_t  = FieldType,
+                                            context  = When}) ->
+    RecId = record_type_name(RecType),
+    Attrs = aeso_syntax:get_ann(RecId),
+    case aeso_tc_env:lookup_type(Env, RecId) of
+        {_, {_Ann, {Formals, {What, Fields}}}} when What =:= record_t; What =:= contract_t ->
+            FieldTypes = [{Name, Type} || {field_t, _, {id, _, Name}, Type} <- Fields],
+            {id, _, FieldString} = FieldName,
+            case proplists:get_value(FieldString, FieldTypes) of
+                undefined ->
+                    type_error({missing_field, FieldName, RecId}),
+                    not_solved;
+                FldType ->
+                    create_freshen_tvars(),
+                    FreshFldType = freshen(FldType),
+                    FreshRecType = freshen(app_t(Attrs, RecId, Formals)),
+                    destroy_freshen_tvars(),
+                    unify(Env, FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}),
+                    unify(Env, FreshRecType, RecType, {record_constraint, FreshRecType, RecType, When}),
+                    C
+            end;
+        _ ->
+            type_error({not_a_record_type, aeso_tc_type_utils:instantiate(RecType), When}),
+            not_solved
+    end;
+solve_constraint(Env, C = #dependent_type_constraint{}) ->
+    check_named_argument_constraint(Env, C);
+solve_constraint(Env, C = #named_argument_constraint{}) ->
+    check_named_argument_constraint(Env, C);
+solve_constraint(_Env, {is_bytes, _}) -> ok;
+solve_constraint(Env, {add_bytes, Ann, _, A0, B0, C0}) ->
+    A = unfold_types_in_type(Env, aeso_tc_type_utils:dereference(A0)),
+    B = unfold_types_in_type(Env, aeso_tc_type_utils:dereference(B0)),
+    C = unfold_types_in_type(Env, aeso_tc_type_utils:dereference(C0)),
+    case {A, B, C} of
+        {{bytes_t, _, M}, {bytes_t, _, N}, _} -> unify(Env, {bytes_t, Ann, M + N}, C, {at, Ann});
+        {{bytes_t, _, M}, _, {bytes_t, _, R}} when R >= M -> unify(Env, {bytes_t, Ann, R - M}, B, {at, Ann});
+        {_, {bytes_t, _, N}, {bytes_t, _, R}} when R >= N -> unify(Env, {bytes_t, Ann, R - N}, A, {at, Ann});
+        _ -> ok
+    end;
+solve_constraint(_, _) -> ok.
+
+check_bytes_constraints(Env, Constraints) ->
+    InAddConstraint = [ T || {add_bytes, _, _, A, B, C} <- Constraints,
+                             T <- [A, B, C],
+                             element(1, T) /= bytes_t ],
+    %% Skip is_bytes constraints for types that occur in add_bytes constraints
+    %% (no need to generate error messages for both is_bytes and add_bytes).
+    Skip = fun({is_bytes, T}) -> lists:member(T, InAddConstraint);
+              (_) -> false end,
+    [ check_bytes_constraint(Env, C) || C <- Constraints, not Skip(C) ].
+
+check_bytes_constraint(Env, {is_bytes, Type}) ->
+    Type1 = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(Type)),
+    case Type1 of
+        {bytes_t, _, _} -> ok;
+        _               ->
+            type_error({unknown_byte_length, Type})
+    end;
+check_bytes_constraint(Env, {add_bytes, Ann, Fun, A0, B0, C0}) ->
+    A = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(A0)),
+    B = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(B0)),
+    C = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(C0)),
+    case {A, B, C} of
+        {{bytes_t, _, _M}, {bytes_t, _, _N}, {bytes_t, _, _R}} ->
+            ok; %% If all are solved we checked M + N == R in solve_constraint.
+        _ -> type_error({unsolved_bytes_constraint, Ann, Fun, A, B, C})
+    end.
+
+check_aens_resolve_constraints(_Env, []) ->
+    ok;
+check_aens_resolve_constraints(Env, [{aens_resolve_type, Type} | Rest]) ->
+    Type1 = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(Type)),
+    {app_t, _, {id, _, "option"}, [Type2]} = Type1,
+    case Type2 of
+        {id, _, "string"} -> ok;
+        {id, _, "address"} -> ok;
+        {con, _, _} -> ok;
+        {app_t, _, {id, _, "oracle"}, [_, _]} -> ok;
+        {app_t, _, {id, _, "oracle_query"}, [_, _]} -> ok;
+        _ -> type_error({invalid_aens_resolve_type, aeso_syntax:get_ann(Type), Type2})
+    end,
+    check_aens_resolve_constraints(Env, Rest).
+
+check_oracle_type_constraints(_Env, []) ->
+    ok;
+check_oracle_type_constraints(Env, [{oracle_type, Ann, OType} | Rest]) ->
+    Type = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(OType)),
+    {app_t, _, {id, _, "oracle"}, [QType, RType]} = Type,
+    is_monomorphic(QType) orelse type_error({invalid_oracle_type, polymorphic,  query,    Ann, Type}),
+    is_monomorphic(RType) orelse type_error({invalid_oracle_type, polymorphic,  response, Ann, Type}),
+    is_first_order(QType) orelse type_error({invalid_oracle_type, higher_order, query,    Ann, Type}),
+    is_first_order(RType) orelse type_error({invalid_oracle_type, higher_order, response, Ann, Type}),
+    check_oracle_type_constraints(Env, Rest).
+
+%% -- Field constraints --
+
+check_record_create_constraints(_, []) -> ok;
+check_record_create_constraints(Env, [C | Cs]) ->
+    #record_create_constraint{
+        record_t = Type,
+        fields   = Fields,
+        context  = When } = C,
+    Type1 = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(Type)),
+    try aeso_tc_env:lookup_type(Env, record_type_name(Type1)) of
+        {_QId, {_Ann, {_Args, {record_t, RecFields}}}} ->
+            ActualNames = [ Fld || {field_t, _, {id, _, Fld}, _} <- RecFields ],
+            GivenNames  = [ Fld || {id, _, Fld} <- Fields ],
+            case ActualNames -- GivenNames of   %% We know already that we don't have too many fields
+                []      -> ok;
+                Missing -> type_error({missing_fields, When, Type1, Missing})
+            end;
+        _ -> %% We can get here if there are other type errors.
+            ok
+    catch _:_ ->    %% Might be unsolved, we get a different error in that case
+        ok
+    end,
+    check_record_create_constraints(Env, Cs).
+
+is_contract_defined(C) ->
+    aeso_tc_ets_manager:ets_lookup(defined_contracts, qname(C)) =/= [].
+
+check_is_contract_constraints(_Env, []) -> ok;
+check_is_contract_constraints(Env, [C | Cs]) ->
+    #is_contract_constraint{ contract_t = Type, context = Cxt, force_def = ForceDef } = C,
+    Type1 = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(Type)),
+    TypeName = record_type_name(Type1),
+    case aeso_tc_env:lookup_type(Env, TypeName) of
+        {_, {_Ann, {[], {contract_t, _}}}} ->
+            case not ForceDef orelse is_contract_defined(TypeName) of
+                true -> ok;
+                false -> type_error({contract_lacks_definition, Type1, Cxt})
+                end;
+        _ -> type_error({not_a_contract_type, Type1, Cxt})
+    end,
+    check_is_contract_constraints(Env, Cs).
+
+-spec solve_unknown_record_types(env(), [field_constraint()]) -> true | [tuple()].
+solve_unknown_record_types(Env, Unknown) ->
+    UVars = lists:usort([UVar || #field_constraint{record_t = UVar = {uvar, _, _}} <- Unknown]),
+    Solutions = [solve_for_uvar(Env, UVar, [{Kind, When, Field}
+                                            || #field_constraint{record_t = U, field = Field, kind = Kind, context = When} <- Unknown,
+                                               U == UVar])
+                 || UVar <- UVars],
+    case lists:member(true, Solutions) of
+        true  -> true;
+        false -> Solutions
+    end.
+
+%% This will solve all kinds of constraints but will only return the
+%% unsolved field constraints
+-spec solve_known_record_types(env(), [constraint()]) -> [field_constraint()].
+solve_known_record_types(Env, Constraints) ->
+    DerefConstraints = lists:map(fun(C = #field_constraint{record_t = RecordType}) ->
+                                        C#field_constraint{record_t = aeso_tc_type_utils:dereference(RecordType)};
+                                    (C) -> aeso_tc_type_utils:dereference_deep(C)
+                                 end, Constraints),
+    SolvedConstraints = lists:map(fun(C) -> solve_constraint(Env, aeso_tc_type_utils:dereference_deep(C)) end, DerefConstraints),
+    Unsolved = DerefConstraints--SolvedConstraints,
+    lists:filter(fun(#field_constraint{}) -> true; (_) -> false end, Unsolved).
+
+record_type_name({app_t, _Attrs, RecId, _Args}) when ?is_type_id(RecId) ->
+    RecId;
+record_type_name(RecId) when ?is_type_id(RecId) ->
+    RecId;
+record_type_name(_Other) ->
+    %% io:format("~p is not a record type\n", [Other]),
+    {id, [{origin, system}], "not_a_record_type"}.
+
+solve_for_uvar(Env, UVar = {uvar, Attrs, _}, Fields0) ->
+    Fields = [{Kind, Fld} || {Kind, _, Fld} <- Fields0],
+    [{_, When, _} | _] = Fields0,    %% Get the location from the first field
+    %% If we have 'create' constraints they must be complete.
+    Covering = lists:usort([ Name || {create, {id, _, Name}} <- Fields ]),
+    %% Does this set of fields uniquely identify a record type?
+    FieldNames = [ Name || {_Kind, {id, _, Name}} <- Fields ],
+    UniqueFields = lists:usort(FieldNames),
+    Candidates = [aeso_tc_env:field_info_record_t(Fld) || Fld <- aeso_tc_env:lookup_record_field(Env, hd(FieldNames))],
+    TypesAndFields = [case aeso_tc_env:lookup_type(Env, record_type_name(RecType)) of
+                        {_, {_, {_, {record_t, RecFields}}}} ->
+                            {RecType, [Field || {field_t, _, {id, _, Field}, _} <- RecFields]};
+                        {_, {_, {_, {contract_t, ConFields}}}} ->
+                            %% TODO: is this right?
+                            {RecType, [Field || {field_t, _, {id, _, Field}, _} <- ConFields]};
+                        false -> %% impossible?
+                            error({no_definition_for, record_type_name(RecType), in, Env})
+                      end
+                      || RecType <- Candidates],
+    PartialSolutions =
+        lists:sort([{RecType, if Covering == [] -> []; true -> RecFields -- Covering end}
+                    || {RecType, RecFields} <- TypesAndFields,
+                       UniqueFields -- RecFields == []]),
+    Solutions = [RecName || {RecName, []} <- PartialSolutions],
+    case {Solutions, PartialSolutions} of
+        {[], []} ->
+            {no_records_with_all_fields, Fields};
+        {[], _} ->
+            case PartialSolutions of
+                [{RecType, Missing} | _] -> %% TODO: better error if ambiguous
+                    {missing_fields, When, RecType, Missing}
+            end;
+        {[RecType], _} ->
+            RecName = record_type_name(RecType),
+            {_, {_, {Formals, {_RecOrCon, _}}}} = aeso_tc_env:lookup_type(Env, RecName),
+            create_freshen_tvars(),
+            FreshRecType = freshen(app_t(Attrs, RecName, Formals)),
+            destroy_freshen_tvars(),
+            unify(Env, UVar, FreshRecType, {solve_rec_type, UVar, Fields}),
+            true;
+        {StillPossible, _} ->
+            {ambiguous_record, Fields, StillPossible}
+    end.
+
+create_freshen_tvars() ->
+    aeso_tc_ets_manager:ets_new(freshen_tvars, [set]).
+
+destroy_freshen_tvars() ->
+    aeso_tc_ets_manager:ets_delete(freshen_tvars).
+
+freshen(Type) ->
+    freshen(aeso_syntax:get_ann(Type), Type).
+
+freshen(Ann, {tvar, _, Name}) ->
+    NewT = case aeso_tc_ets_manager:ets_lookup(freshen_tvars, Name) of
+               []          -> fresh_uvar(Ann);
+               [{Name, T}] -> T
+           end,
+    aeso_tc_ets_manager:ets_insert(freshen_tvars, {Name, NewT}),
+    NewT;
+freshen(Ann, {bytes_t, _, any}) ->
+    X = fresh_uvar(Ann),
+    add_constraint({is_bytes, X}),
+    X;
+freshen(Ann, T) when is_tuple(T) ->
+    list_to_tuple(freshen(Ann, tuple_to_list(T)));
+freshen(Ann, [A | B]) ->
+    [freshen(Ann, A) | freshen(Ann, B)];
+freshen(_, X) ->
+    X.
+
+freshen_type(Ann, Type) ->
+    create_freshen_tvars(),
+    Type1 = freshen(Ann, Type),
+    destroy_freshen_tvars(),
+    Type1.
+
+freshen_type_sig(Ann, TypeSig = {type_sig, _, Constr, _, _, _}) ->
+    FunT = freshen_type(Ann, aeso_tc_type_utils:typesig_to_fun_t(TypeSig)),
+    apply_typesig_constraint(Ann, Constr, FunT),
+    FunT.
+
+apply_typesig_constraint(_Ann, none, _FunT) -> ok;
+apply_typesig_constraint(Ann, address_to_contract, {fun_t, _, [], [_], Type}) ->
+    aeso_tc_constraints:add_is_contract_constraint(Type, {address_to_contract, Ann});
+apply_typesig_constraint(Ann, bytes_concat, {fun_t, _, [], [A, B], C}) ->
+    add_constraint({add_bytes, Ann, concat, A, B, C});
+apply_typesig_constraint(Ann, bytes_split, {fun_t, _, [], [C], {tuple_t, _, [A, B]}}) ->
+    add_constraint({add_bytes, Ann, split, A, B, C});
+apply_typesig_constraint(Ann, bytecode_hash, {fun_t, _, _, [Con], _}) ->
+    aeso_tc_constraints:add_is_contract_constraint(Con, {bytecode_hash, Ann}).

src/aeso_tc_desugar.erl

@@ -0,0 +1,138 @@
+-module(aeso_tc_desugar).
+
+-export([ desugar/1
+        , desugar_clauses/4
+        , process_blocks/1
+        ]).
+
+%% -- Moved functions --------------------------------------------------------
+
+type_error(A) -> aeso_tc_errors:type_error(A).
+
+%% ---------------------------------------------------------------------------
+
+%% Restructure blocks into multi-clause fundefs (`fun_clauses`).
+-spec process_blocks([aeso_syntax:decl()]) -> [aeso_syntax:decl()].
+process_blocks(Decls) ->
+    lists:flatmap(
+      fun({block, Ann, Ds}) -> process_block(Ann, Ds);
+         (Decl)             -> [Decl] end, Decls).
+
+-spec process_block(aeso_syntax:ann(), [aeso_syntax:decl()]) -> [aeso_syntax:decl()].
+process_block(_, []) -> [];
+process_block(_, [Decl]) -> [Decl];
+process_block(_Ann, [Decl | Decls]) ->
+    IsThis = fun(Name) -> fun({letfun, _, {id, _, Name1}, _, _, _}) -> Name == Name1;
+                             (_) -> false end end,
+    case Decl of
+        {fun_decl, Ann1, Id = {id, _, Name}, Type} ->
+            {Clauses, Rest} = lists:splitwith(IsThis(Name), Decls),
+            [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest],
+            [{fun_clauses, Ann1, Id, Type, Clauses}];
+        {letfun, Ann1, Id = {id, _, Name}, _, _, _} ->
+            {Clauses, Rest} = lists:splitwith(IsThis(Name), [Decl | Decls]),
+            [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest],
+            [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses}]
+    end.
+
+desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) ->
+    NeedDesugar =
+        case Clauses of
+            [{letfun, _, _, As, _, [{guarded, _, [], _}]}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As);
+            _                                              -> true
+        end,
+    case NeedDesugar of
+        false -> [Clause] = Clauses, Clause;
+        true  ->
+            NoAnn = [{origin, system}],
+            Args = [ {typed, NoAnn, {id, NoAnn, "x#" ++ integer_to_list(I)}, Type}
+                     || {I, Type} <- indexed(1, ArgTypes) ],
+            Tuple = fun([X]) -> X;
+                       (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}}
+                    end,
+            {letfun, Ann, Fun, Args, RetType, [{guarded, NoAnn, [], {typed, NoAnn,
+               {switch, NoAnn, Tuple(Args),
+                 [ {'case', AnnC, Tuple(ArgsC), GuardedBodies}
+                 || {letfun, AnnC, _, ArgsC, _, GuardedBodies} <- Clauses ]}, RetType}}]}
+    end.
+
+%% -- Pre-type checking desugaring -------------------------------------------
+
+%% Desugars nested record/map updates as follows:
+%%  { x.y = v1, x.z @ z = f(z) } becomes { x @ __x = __x { y = v1, z @ z = f(z) } }
+%%  { [k1].x = v1, [k2].y = v2 } becomes { [k1] @ __x = __x { x = v1 }, [k2] @ __x = __x { y = v2 } }
+%% There's no comparison of k1 and k2 to group the updates if they are equal.
+desugar({record, Ann, Rec, Updates}) ->
+    {record, Ann, Rec, desugar_updates(Updates)};
+desugar({map, Ann, Map, Updates}) ->
+    {map, Ann, Map, desugar_updates(Updates)};
+desugar([H|T]) ->
+  [desugar(H) | desugar(T)];
+desugar(T) when is_tuple(T) ->
+  list_to_tuple(desugar(tuple_to_list(T)));
+desugar(X) -> X.
+
+desugar_updates([]) -> [];
+desugar_updates([Upd | Updates]) ->
+    {Key, MakeField, Rest} = update_key(Upd),
+    {More, Updates1}       = updates_key(Key, Updates),
+    %% Check conflicts
+    case length([ [] || [] <- [Rest | More] ]) of
+        N when N > 1 -> type_error({conflicting_updates_for_field, Upd, Key});
+        _ -> ok
+    end,
+    [MakeField(lists:append([Rest | More])) | desugar_updates(Updates1)].
+
+%% TODO: refactor representation to make this not horrible
+update_key(Fld = {field, _, [Elim], _}) ->
+    {elim_key(Elim), fun(_) -> Fld end, []};
+update_key(Fld = {field, _, [Elim], _, _}) ->
+    {elim_key(Elim), fun(_) -> Fld end, []};
+update_key({field, Ann, [P = {proj, _, {id, _, Name}} | Rest], Value}) ->
+    {Name, fun(Flds) -> {field, Ann, [P], {id, [], "__x"},
+                            desugar(map_or_record(Ann, {id, [], "__x"}, Flds))}
+           end, [{field, Ann, Rest, Value}]};
+update_key({field, Ann, [P = {proj, _, {id, _, Name}} | Rest], Id, Value}) ->
+    {Name, fun(Flds) -> {field, Ann, [P], {id, [], "__x"},
+                            desugar(map_or_record(Ann, {id, [], "__x"}, Flds))}
+           end, [{field, Ann, Rest, Id, Value}]};
+update_key({field, Ann, [K = {map_get, _, _} | Rest], Value}) ->
+    {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"},
+                            desugar(map_or_record(Ann, {id, [], "__x"}, Flds))}
+              end, [{field, Ann, Rest, Value}]};
+update_key({field, Ann, [K = {map_get, _, _, _} | Rest], Value}) ->
+    {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"},
+                            desugar(map_or_record(Ann, {id, [], "__x"}, Flds))}
+              end, [{field, Ann, Rest, Value}]};
+update_key({field, Ann, [K = {map_get, _, _, _} | Rest], Id, Value}) ->
+    {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"},
+                            desugar(map_or_record(Ann, {id, [], "__x"}, Flds))}
+              end, [{field, Ann, Rest, Id, Value}]};
+update_key({field, Ann, [K = {map_get, _, _} | Rest], Id, Value}) ->
+    {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"},
+                            desugar(map_or_record(Ann, {id, [], "__x"}, Flds))}
+              end, [{field, Ann, Rest, Id, Value}]}.
+
+map_or_record(Ann, Val, Flds = [Fld | _]) ->
+    Kind = case element(3, Fld) of
+             [{proj, _, _}       | _] -> record;
+             [{map_get, _, _}    | _] -> map;
+             [{map_get, _, _, _} | _] -> map
+           end,
+    {Kind, Ann, Val, Flds}.
+
+elim_key({proj, _, {id, _, Name}}) -> Name;
+elim_key({map_get, _, _, _})       -> map_key;  %% no grouping on map keys (yet)
+elim_key({map_get, _, _})          -> map_key.
+
+updates_key(map_key, Updates) -> {[], Updates};
+updates_key(Name, Updates) ->
+    Xs = [ {Upd, Name1 == Name, Rest}
+           || Upd <- Updates,
+              {Name1, _, Rest} <- [update_key(Upd)] ],
+    Updates1 = [ Upd  || {Upd, false, _} <- Xs ],
+    More     = [ Rest || {_, true, Rest} <- Xs ],
+    {More, Updates1}.
+
+indexed(I, Xs) ->
+    lists:zip(lists:seq(I, I + length(Xs) - 1), Xs).

src/aeso_tc_env.erl

@@ -0,0 +1,941 @@
+-module(aeso_tc_env).
+
+%% Getters
+-export([ contract_parents/1
+        , current_function/1
+        , in_guard/1
+        , in_pattern/1
+        , namespace/1
+        , stateful/1
+        , typevars/1
+        , unify_throws/1
+        , used_namespaces/1
+        , vars/1
+        , what/1
+        ]).
+
+-export([ field_info_field_t/1
+        , field_info_record_t/1
+        ]).
+
+-export([ scope_ann/1
+        , scope_consts/1
+        , scope_funs/1
+        , scope_kind/1
+        ]).
+
+%% Setters
+-export([ set_contract_parents/2
+        , set_current_const/2
+        , set_current_function/2
+        , set_in_guard/2
+        , set_in_pattern/2
+        , set_stateful/2
+        , set_used_namespaces/2
+        , set_what/2
+        ]).
+
+-export([ push_scope/3
+        , pop_scope/1
+        , get_scope/2
+        , get_current_scope/1
+        , on_scopes/2
+        , switch_scope/2
+        , bind_var/3
+        , bind_vars/2
+        , bind_contract/3
+        , bind_state/1
+        , bind_fun/3
+        , bind_funs/2
+        , bind_tvars/2
+        , bind_type/4
+        , bind_const/4
+        , bind_fields_append/4
+        ]).
+
+-export([ lookup_env/4
+        , lookup_type/2
+        , lookup_record_field/2
+        , lookup_record_field/3
+        , lookup_record_field_arity/4
+        ]).
+
+%% Env constructors
+-export([ init_env/0
+        , init_env/1
+        , empty_env/0
+        ]).
+
+-export([destroy_and_report_type_errors/1]).
+
+-export_type([env/0]).
+
+-include("aeso_utils.hrl").
+
+-record(field_info,
+    { ann      :: aeso_syntax:ann()
+    , field_t  :: utype()
+    , record_t :: utype()
+    , kind     :: contract | record }).
+
+-type field_info() :: #field_info{}.
+
+-type type_id() :: aeso_syntax:id() | aeso_syntax:qid() | aeso_syntax:con() | aeso_syntax:qcon().
+
+-type typedef() :: {[aeso_syntax:tvar()], aeso_syntax:typedef() | {contract_t, [aeso_syntax:field_t()]}}
+                 | {builtin, non_neg_integer()}.
+
+-type namespace_alias() :: none | name().
+-type namespace_parts() :: none | {for, [name()]} | {hiding, [name()]}.
+-type used_namespaces() :: [{qname(), namespace_alias(), namespace_parts()}].
+
+-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 const_env() :: [{name(), const_info()}].
+
+-record(scope, { funs   = [] :: fun_env()
+               , types  = [] :: type_env()
+               , consts = [] :: const_env()
+               , kind   = namespace :: namespace | contract
+               , ann    = [{origin, system}] :: aeso_syntax:ann()
+               }).
+
+-type scope() :: #scope{}.
+
+-record(env,
+    { scopes           = #{ [] => #scope{}} :: #{ qname() => scope() }
+    , vars             = []                 :: [{name(), var_info()}]
+    , typevars         = unrestricted       :: unrestricted | [name()]
+    , fields           = #{}                :: #{ name() => [field_info()] }    %% fields are global
+    , contract_parents = #{}                :: #{ name() => [name()] }
+    , namespace        = []                 :: qname()
+    , used_namespaces  = []                 :: used_namespaces()
+    , in_pattern       = false              :: boolean()
+    , 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
+    }).
+
+-opaque env() :: #env{}.
+
+%% -- Duplicated types -------------------------------------------------------
+
+-type name() :: string().
+-type qname() :: [string()].
+-type type() :: aeso_syntax:type().
+-type utype() :: aeso_tc_typedefs:utype().
+-type typesig() :: aeso_tc_typedefs:typesig().
+
+%% -- Duplicated macros ------------------------------------------------------
+
+-define(CONSTRUCTOR_MOCK_NAME, "#__constructor__#").
+
+%% -- Moved functions --------------------------------------------------------
+
+name(A) -> aeso_tc_name_manip:name(A).
+qname(A) -> aeso_tc_name_manip:qname(A).
+qid(A, B) -> aeso_tc_name_manip:qid(A, B).
+qcon(A, B) -> aeso_tc_name_manip:qcon(A, B).
+
+%% -------
+
+type_error(A) -> aeso_tc_errors:type_error(A).
+
+%% -------
+
+warn_potential_shadowing(A, B, C) -> aeso_tc_warnings:warn_potential_shadowing(A, B, C).
+used_include(A) -> aeso_tc_warnings:used_include(A).
+
+%% -------
+
+get_option(A, B) -> aeso_tc_options:get_option(A, B).
+when_warning(A, B) -> aeso_tc_options:when_warning(A, B).
+
+%% -------
+
+fresh_uvar(A) -> aeso_tc_type_utils:fresh_uvar(A).
+
+%% -- Getters ------------------------------------------------------------
+
+contract_parents(#env{contract_parents = ContractParents}) ->
+    ContractParents.
+
+current_function(#env{current_function = CurrentFunction}) ->
+    CurrentFunction.
+
+in_guard(#env{in_guard = InGuard}) ->
+    InGuard.
+
+in_pattern(#env{in_pattern = InPattern}) ->
+    InPattern.
+
+namespace(#env{namespace = Namespace}) ->
+    Namespace.
+
+stateful(#env{stateful = Stateful}) ->
+    Stateful.
+
+typevars(#env{typevars = Typevars}) ->
+    Typevars.
+
+unify_throws(#env{unify_throws = UnifyThrows}) ->
+    UnifyThrows.
+
+used_namespaces(#env{used_namespaces = UsedNamespaces}) ->
+    UsedNamespaces.
+
+vars(#env{vars = Vars}) ->
+    Vars.
+
+what(#env{what = What}) ->
+    What.
+
+%% -- Field Info Getters -------------------------------------------------
+
+field_info_field_t(#field_info{field_t = FieldT}) ->
+    FieldT.
+
+field_info_record_t(#field_info{record_t = RecordT}) ->
+    RecordT.
+
+%% -- Scope Getters ------------------------------------------------------
+
+scope_ann(#scope{ann = Ann}) ->
+    Ann.
+
+scope_consts(#scope{consts = Consts}) ->
+    Consts.
+
+scope_funs(#scope{funs = Funs}) ->
+    Funs.
+
+scope_kind(#scope{kind = Kind}) ->
+    Kind.
+
+%% -- Setters ------------------------------------------------------------
+
+set_contract_parents(ContractParents, Env) ->
+    Env#env{contract_parents = ContractParents}.
+
+set_current_const(CurrentConst, Env) ->
+    Env#env{current_const = CurrentConst}.
+
+set_current_function(CurrentFunction, Env) ->
+    Env#env{current_function = CurrentFunction}.
+
+set_in_guard(InGuard, Env) ->
+    Env#env{in_guard = InGuard}.
+
+set_in_pattern(InPattern, Env) ->
+    Env#env{in_pattern = InPattern}.
+
+set_stateful(Stateful, Env) ->
+    Env#env{stateful = Stateful}.
+
+set_used_namespaces(UsedNamespaces, Env) ->
+    Env#env{used_namespaces = UsedNamespaces}.
+
+set_what(What, Env) ->
+    Env#env{what = What}.
+
+%% -- Environment manipulation -----------------------------------------------
+
+-spec switch_scope(qname(), env()) -> env().
+switch_scope(Scope, Env) ->
+    Env#env{namespace = Scope}.
+
+-spec push_scope(namespace | contract, aeso_syntax:con(), env()) -> env().
+push_scope(Kind, Con, Env) ->
+    Ann  = aeso_syntax:get_ann(Con),
+    Name = name(Con),
+    New  = Env#env.namespace ++ [Name],
+    Env#env{ namespace = New, scopes = (Env#env.scopes)#{ New => #scope{ kind = Kind, ann = Ann } } }.
+
+-spec pop_scope(env()) -> env().
+pop_scope(Env) ->
+    Env#env{ namespace = lists:droplast(Env#env.namespace) }.
+
+-spec get_scope(env(), qname()) -> false | scope().
+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 = get_current_scope(Env),
+    Env#env{ scopes = Scopes#{ NS => Fun(Scope) } }.
+
+-spec on_scopes(env(), fun((scope()) -> scope())) -> env().
+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) ->
+    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().
+bind_vars([], Env) -> Env;
+bind_vars([{X, T} | Vars], Env) ->
+    bind_vars(Vars, bind_var(X, T, Env)).
+
+-spec bind_tvars([aeso_syntax:tvar()], env()) -> env().
+bind_tvars(Xs, Env) ->
+    Env#env{ typevars = [X || {tvar, _, X} <- Xs] }.
+
+-spec bind_fun(name(), type() | typesig(), env()) -> env().
+bind_fun(X, Type, Env) ->
+    case lookup_env(Env, term, [], [X]) of
+        false -> force_bind_fun(X, Type, Env);
+        {_QId, {Ann1, _}} ->
+            type_error({duplicate_definition, X, [Ann1, aeso_syntax:get_ann(Type)]}),
+            Env
+    end.
+
+-spec force_bind_fun(name(), type() | typesig(), env()) -> env().
+force_bind_fun(X, Type, Env = #env{ what = What }) ->
+    Ann    = aeso_syntax:get_ann(Type),
+    NoCode = get_option(no_code, false),
+    Entry = if X == "init", What == contract, not NoCode ->
+                    {reserved_init, Ann, Type};
+               What == contract; What == contract_interface -> {contract_fun, Ann, Type};
+               true -> {Ann, Type}
+            end,
+    on_current_scope(Env, fun(Scope = #scope{ funs = Funs }) ->
+                            Scope#scope{ funs = [{X, Entry} | Funs] }
+                          end).
+
+-spec bind_funs([{name(), type() | typesig()}], env()) -> env().
+bind_funs([], Env) -> Env;
+bind_funs([{Id, Type} | Rest], Env) ->
+    bind_funs(Rest, bind_fun(Id, Type, Env)).
+
+-spec bind_type(name(), aeso_syntax:ann(), typedef(), env()) -> env().
+bind_type(X, Ann, Def, Env) ->
+    on_current_scope(Env, fun(Scope = #scope{ types = Types }) ->
+                            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.
+
+%% Bind state primitives
+-spec bind_state(env()) -> env().
+bind_state(Env) ->
+    Ann   = [{origin, system}],
+    Unit  = {tuple_t, Ann, []},
+    State =
+        case lookup_type(Env, {id, Ann, "state"}) of
+            {S, _} -> {qid, Ann, S};
+            false  -> Unit
+        end,
+    Env1 = bind_funs([{"state", State},
+                      {"put", {type_sig, [stateful | Ann], none, [], [State], Unit}}], Env),
+
+    case lookup_type(Env, {id, Ann, "event"}) of
+        {E, _} ->
+            %% We bind Chain.event in a local 'Chain' namespace.
+            Event = {qid, Ann, E},
+            pop_scope(
+              bind_fun("event", {fun_t, Ann, [], [Event], Unit},
+              push_scope(namespace, {con, Ann, "Chain"}, Env1)));
+        false  -> Env1
+    end.
+
+%-spec bind_fields_append(env(), #{ name() => aeso_syntax:decl() }, type(), [aeso_syntax:field_t()]) -> env().
+bind_fields_append(Env, _TypeMap, _, []) -> Env;
+bind_fields_append(Env, TypeMap, RecTy, [{field_t, Ann, Id, Type} | Fields]) ->
+    Env1 = bind_field_append(name(Id), #field_info{ ann = Ann, kind = record, field_t = Type, record_t = RecTy }, Env),
+    bind_fields_append(Env1, TypeMap, RecTy, Fields).
+
+-spec bind_field_append(name(), field_info(), env()) -> env().
+bind_field_append(X, Info, Env = #env{ fields = Fields }) ->
+    Fields1 = maps:update_with(X, fun(Infos) -> [Info | Infos] end, [Info], Fields),
+    Env#env{ fields = Fields1 }.
+
+-spec bind_field_update(name(), field_info(), env()) -> env().
+bind_field_update(X, Info, Env = #env{ fields = Fields }) ->
+    Fields1 = maps:update_with(X, fun([_ | Infos]) -> [Info | Infos]; ([]) -> [Info] end, [Info], Fields),
+    Env#env{ fields = Fields1 }.
+
+-spec bind_fields([{name(), field_info()}], typed | untyped, env()) -> env().
+bind_fields([], _Typing, Env) -> Env;
+bind_fields([{Id, Info} | Rest], Typing, Env) ->
+    NewEnv = case Typing of
+                 untyped -> bind_field_append(Id, Info, Env);
+                 typed   -> bind_field_update(Id, Info, Env)
+             end,
+    bind_fields(Rest, Typing, NewEnv).
+
+%% Contract entrypoints take three named arguments
+%%  gas       : int  = Call.gas_left()
+%%  value     : int  = 0
+%%  protected : bool = false
+contract_call_type({fun_t, Ann, [], Args, Ret}) ->
+    Id    = fun(X) -> {id, Ann, X} end,
+    Int   = Id("int"),
+    Typed = fun(E, T) -> {typed, Ann, E, T} end,
+    Named = fun(Name, Default = {typed, _, _, T}) -> {named_arg_t, Ann, Id(Name), T, Default} end,
+    {fun_t, Ann, [Named("gas",   Typed({app, Ann, Typed({qid, Ann, ["Call", "gas_left"]},
+                                                        {fun_t, Ann, [], [], Int}),
+                                        []}, Int)),
+                  Named("value", Typed({int, Ann, 0}, Int)),
+                  Named("protected", Typed({bool, Ann, false}, Id("bool")))],
+     Args, {if_t, Ann, Id("protected"), {app_t, Ann, {id, Ann, "option"}, [Ret]}, Ret}}.
+
+-spec bind_contract(typed | untyped, aeso_syntax:decl(), env()) -> env().
+bind_contract(Typing, {Contract, Ann, Id, _Impls, Contents}, Env)
+  when ?IS_CONTRACT_HEAD(Contract) ->
+    Key         = name(Id),
+    Sys         = [{origin, system}],
+    TypeOrFresh = fun({typed, _, _, Type}) -> Type; (_) -> fresh_uvar(Sys) end,
+    Fields      =
+        [ {field_t, AnnF, Entrypoint, contract_call_type(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)})
+          }
+          || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, [{guarded, _, [], Ret}]} <- Contents,
+             Name =/= "init"
+        ] ++
+        %% Predefined fields
+        [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ] ++
+        [ {field_t, Sys, {id, Sys, ?CONSTRUCTOR_MOCK_NAME},
+           contract_call_type(
+             case [ [TypeOrFresh(Arg) || Arg <- Args]
+                    || {letfun, AnnF, {id, _, "init"}, Args, _, _} <- Contents,
+                       aeso_syntax:get_ann(entrypoint, AnnF, false)]
+                 ++ [ Args
+                      || {fun_decl, AnnF, {id, _, "init"}, {fun_t, _, _, Args, _}} <- Contents,
+                         aeso_syntax:get_ann(entrypoint, AnnF, false)]
+                 ++ [ Args
+                      || {fun_decl, AnnF, {id, _, "init"}, {type_sig, _, _, _, Args, _}} <- Contents,
+                         aeso_syntax:get_ann(entrypoint, AnnF, false)]
+             of
+                 [] -> {fun_t, [stateful,payable|Sys], [], [], {id, Sys, "void"}};
+                 [Args] -> {fun_t, [stateful,payable|Sys], [], Args, {id, Sys, "void"}}
+             end
+            )
+          }
+        ],
+    FieldInfo = [ {Entrypoint, #field_info{ ann      = FieldAnn,
+                                            kind     = contract,
+                                            field_t  = Type,
+                                            record_t = Id }}
+                || {field_t, _, {id, FieldAnn, Entrypoint}, Type} <- Fields ],
+    bind_type(Key, Ann, {[], {contract_t, Fields}},
+        bind_fields(FieldInfo, Typing, Env)).
+
+%% What scopes could a given name come from?
+-spec possible_scopes(env(), qname()) -> [qname()].
+possible_scopes(#env{ namespace = Current, used_namespaces = UsedNamespaces }, Name) ->
+    Qual = lists:droplast(Name),
+    NewQuals = case lists:filter(fun(X) -> element(2, X) == Qual end, UsedNamespaces) of
+                   [] ->
+                       [Qual];
+                   Namespaces ->
+                       lists:map(fun(X) -> element(1, X) end, Namespaces)
+               end,
+    Ret1 = [ lists:sublist(Current, I) ++ Q || I <- lists:seq(0, length(Current)), Q <- NewQuals ],
+    Ret2 = [ Namespace ++ Q || {Namespace, none, _} <- UsedNamespaces, Q <- NewQuals ],
+    lists:usort(Ret1 ++ Ret2).
+
+-spec visible_in_used_namespaces(used_namespaces(), qname()) -> boolean().
+visible_in_used_namespaces(UsedNamespaces, QName) ->
+    Qual = lists:droplast(QName),
+    Name = lists:last(QName),
+    case lists:filter(fun({Ns, _, _}) -> Qual == Ns end, UsedNamespaces) of
+        [] ->
+            true;
+        Namespaces ->
+            IsVisible = fun(Namespace) ->
+                            case Namespace of
+                                {_, _, {for, Names}} ->
+                                    lists:member(Name, Names);
+                                {_, _, {hiding, Names}} ->
+                                    not lists:member(Name, Names);
+                                _ ->
+                                    true
+                            end
+                        end,
+            lists:any(IsVisible, Namespaces)
+    end.
+
+-spec lookup_type(env(), type_id()) -> false | {qname(), type_info()}.
+lookup_type(Env, Id) ->
+    lookup_env(Env, type, aeso_syntax:get_ann(Id), qname(Id)).
+
+-spec lookup_env(env(), term, aeso_syntax:ann(), qname()) -> false | {qname(), fun_info()};
+                (env(), type, aeso_syntax:ann(), qname()) -> false | {qname(), type_info()}.
+lookup_env(Env, Kind, Ann, Name) ->
+    Var = case Name of
+            [X] when Kind == term -> proplists:get_value(X, Env#env.vars, false);
+            _                     -> false
+          end,
+    case Var of
+        {Ann1, Type} -> {Name, {Ann1, Type}};
+        false ->
+            Names = [ Qual ++ [lists:last(Name)] || Qual <- possible_scopes(Env, Name) ],
+            case [ Res || QName <- Names, Res <- [lookup_env1(Env, Kind, Ann, QName)], Res /= false] of
+                []    -> false;
+                [Res = {_, {AnnR, _}}] ->
+                    when_warning(warn_unused_includes,
+                                 fun() ->
+                                         %% If a file is used from a different file, we
+                                         %% can then mark it as used
+                                         F1 = proplists:get_value(file, Ann, no_file),
+                                         F2 = proplists:get_value(file, AnnR, no_file),
+                                         if
+                                             F1 /= F2 ->
+                                                 used_include(AnnR);
+                                             true ->
+                                                 ok
+                                         end
+                                 end),
+                    Res;
+                Many  ->
+                    type_error({ambiguous_name, qid(Ann, Name), [{qid, A, Q} || {Q, {A, _}} <- Many]}),
+                    false
+            end
+    end.
+
+-spec lookup_env1(env(), type | term, aeso_syntax:ann(), qname()) -> false | {qname(), fun_info() | type_info()}.
+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, 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 ->
+                    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_entrypoint, Ann, QName}),
+                    {QName, {Ann1, Type}};
+                {Ann1, _} = E ->
+                    %% Check that it's not private (or we can see private funs)
+                    case not is_private(Ann1) orelse AllowPrivate of
+                        true  ->
+                            case visible_in_used_namespaces(UsedNamespaces, QName) of
+                                true -> {QName, E};
+                                false -> false
+                            end;
+                        false -> false
+                    end
+            end
+    end.
+
+-spec lookup_record_field(env(), name()) -> [field_info()].
+lookup_record_field(Env, FieldName) ->
+    maps:get(FieldName, Env#env.fields, []).
+
+%% For 'create' or 'update' constraints we don't consider contract types.
+-spec lookup_record_field(env(), name(), create | project | update) -> [field_info()].
+lookup_record_field(Env, FieldName, Kind) ->
+    [ Fld || Fld = #field_info{ kind = K } <- lookup_record_field(Env, FieldName),
+             Kind == project orelse K /= contract ].
+
+lookup_record_field_arity(Env, FieldName, Arity, Kind) ->
+    Fields = lookup_record_field(Env, FieldName, Kind),
+    [ Fld || Fld = #field_info{ field_t = FldType } <- Fields,
+             aeso_tc_type_utils:fun_arity(aeso_tc_type_utils:dereference_deep(FldType)) == Arity ].
+
+is_private(Ann) -> proplists:get_value(private, Ann, false).
+
+option_t(As, T) -> {app_t, As, {id, As, "option"}, [T]}.
+
+init_env() -> init_env([]).
+
+init_env(_Options) -> global_env().
+
+-spec empty_env() -> env().
+empty_env() -> #env{}.
+
+%% Environment containing language primitives
+-spec global_env() -> env().
+global_env() ->
+    Ann     = [{origin, system}],
+    Int     = {id, Ann, "int"},
+    Char    = {id, Ann, "char"},
+    Bool    = {id, Ann, "bool"},
+    String  = {id, Ann, "string"},
+    Address = {id, Ann, "address"},
+    Hash    = {id, Ann, "hash"},
+    Bits    = {id, Ann, "bits"},
+    Bytes   = fun(Len) -> {bytes_t, Ann, Len} end,
+    Oracle  = fun(Q, R) -> {app_t, Ann, {id, Ann, "oracle"}, [Q, R]} end,
+    Query   = fun(Q, R) -> {app_t, Ann, {id, Ann, "oracle_query"}, [Q, R]} end,
+    Unit    = {tuple_t, Ann, []},
+    List    = fun(T) -> {app_t, Ann, {id, Ann, "list"}, [T]} end,
+    Option  = fun(T) -> {app_t, Ann, {id, Ann, "option"}, [T]} end,
+    Map     = fun(A, B) -> {app_t, Ann, {id, Ann, "map"}, [A, B]} end,
+    Pair    = fun(A, B) -> {tuple_t, Ann, [A, B]} end,
+    FunC    = fun(C, Ts, T) -> {type_sig, Ann, C, [], Ts, T} end,
+    FunC1   = fun(C, S, T) -> {type_sig, Ann, C, [], [S], T} end,
+    Fun     = fun(Ts, T) -> FunC(none, Ts, T) end,
+    Fun1    = fun(S, T) -> Fun([S], T) end,
+    FunCN   = fun(C, Named, Normal, Ret) -> {type_sig, Ann, C, Named, Normal, Ret} end,
+    FunN    = fun(Named, Normal, Ret) -> FunCN(none, Named, Normal, Ret) end,
+    %% Lambda    = fun(Ts, T) -> {fun_t, Ann, [], Ts, T} end,
+    %% Lambda1   = fun(S, T) -> Lambda([S], T) end,
+    StateFun  = fun(Ts, T) -> {type_sig, [stateful|Ann], none, [], Ts, T} end,
+    TVar      = fun(X) -> {tvar, Ann, "'" ++ X} end,
+    SignId    = {id, Ann, "signature"},
+    SignDef   = {bytes, Ann, <<0:64/unit:8>>},
+    Signature = {named_arg_t, Ann, SignId, SignId, {typed, Ann, SignDef, SignId}},
+    SignFun   = fun(Ts, T) -> {type_sig, [stateful|Ann], none, [Signature], Ts, T} end,
+    TTL       = {qid, Ann, ["Chain", "ttl"]},
+    Pointee   = {qid, Ann, ["AENS", "pointee"]},
+    AENSName  = {qid, Ann, ["AENS", "name"]},
+    Fr        = {qid, Ann, ["MCL_BLS12_381", "fr"]},
+    Fp        = {qid, Ann, ["MCL_BLS12_381", "fp"]},
+    Fp2       = {tuple_t, Ann, [Fp, Fp]},
+    G1        = {tuple_t, Ann, [Fp, Fp, Fp]},
+    G2        = {tuple_t, Ann, [Fp2, Fp2, Fp2]},
+    GT        = {tuple_t, Ann, lists:duplicate(12, Fp)},
+    Tx        = {qid, Ann, ["Chain", "tx"]},
+    GAMetaTx  = {qid, Ann, ["Chain", "ga_meta_tx"]},
+    BaseTx    = {qid, Ann, ["Chain", "base_tx"]},
+    PayForTx  = {qid, Ann, ["Chain", "paying_for_tx"]},
+
+    FldT      = fun(Id, T) -> {field_t, Ann, {id, Ann, Id}, T} end,
+    TxFlds    = [{"paying_for", Option(PayForTx)}, {"ga_metas", List(GAMetaTx)},
+                 {"actor", Address}, {"fee", Int}, {"ttl", Int}, {"tx", BaseTx}],
+    TxType    = {record_t, [FldT(N, T) || {N, T} <- TxFlds ]},
+    Stateful  = fun(T) -> setelement(2, T, [stateful|element(2, T)]) end,
+
+    Fee       = Int,
+    [A, Q, R, K, V] = lists:map(TVar, ["a", "q", "r", "k", "v"]),
+
+    MkDefs = fun(Defs) -> [{X, {Ann, if is_integer(T) -> {builtin, T}; true -> T end}} || {X, T} <- Defs] end,
+
+    TopScope = #scope
+        { funs  = MkDefs(
+                     %% Option constructors
+                    [{"None", Option(A)},
+                     {"Some", Fun1(A, Option(A))},
+                     %% TTL constructors
+                     {"RelativeTTL", Fun1(Int, TTL)},
+                     {"FixedTTL",    Fun1(Int, TTL)},
+                     %% Abort/exit
+                     {"abort", Fun1(String, A)},
+                     {"exit", Fun1(String, A)},
+                     {"require", Fun([Bool, String], Unit)}])
+        , types = MkDefs(
+                    [{"int", 0}, {"bool", 0}, {"char", 0}, {"string", 0}, {"address", 0},
+                     {"void", 0},
+                     {"unit", {[], {alias_t, Unit}}},
+                     {"hash", {[], {alias_t, Bytes(32)}}},
+                     {"signature", {[], {alias_t, Bytes(64)}}},
+                     {"bits", 0},
+                     {"option", 1}, {"list", 1}, {"map", 2},
+                     {"oracle", 2}, {"oracle_query", 2}
+                     ]) },
+
+    ChainScope = #scope
+        { funs = MkDefs(
+                     %% Spend transaction.
+                    [{"spend",        StateFun([Address, Int], Unit)},
+                     %% Chain environment
+                     {"balance",      Fun1(Address, Int)},
+                     {"block_hash",   Fun1(Int, Option(Hash))},
+                     {"coinbase",     Address},
+                     {"timestamp",    Int},
+                     {"block_height", Int},
+                     {"difficulty",   Int},
+                     {"gas_limit",    Int},
+                     {"bytecode_hash",FunC1(bytecode_hash, A, Option(Hash))},
+                     {"create",       Stateful(
+                                        FunN([ {named_arg_t, Ann, {id, Ann, "value"}, Int, {typed, Ann, {int, Ann, 0}, Int}}
+                                             ], var_args, A))},
+                     {"clone",        Stateful(
+                                        FunN([ {named_arg_t, Ann, {id, Ann, "gas"}, Int,
+                                                {typed, Ann,
+                                                 {app, Ann,
+                                                  {typed, Ann, {qid, Ann, ["Call","gas_left"]},
+                                                   aeso_tc_type_utils:typesig_to_fun_t(Fun([], Int))
+                                                  },
+                                                  []}, Int
+                                                }}
+                                             , {named_arg_t, Ann, {id, Ann, "value"}, Int, {typed, Ann, {int, Ann, 0}, Int}}
+                                             , {named_arg_t, Ann, {id, Ann, "protected"}, Bool, {typed, Ann, {bool, Ann, false}, Bool}}
+                                             , {named_arg_t, Ann, {id, Ann, "ref"}, A, undefined}
+                                             ], var_args, A))},
+                     %% Tx constructors
+                     {"GAMetaTx",     Fun([Address, Int], GAMetaTx)},
+                     {"PayingForTx",  Fun([Address, Int], PayForTx)},
+                     {"SpendTx",      Fun([Address, Int, String], BaseTx)},
+                     {"OracleRegisterTx",       BaseTx},
+                     {"OracleQueryTx",          BaseTx},
+                     {"OracleResponseTx",       BaseTx},
+                     {"OracleExtendTx",         BaseTx},
+                     {"NamePreclaimTx",         BaseTx},
+                     {"NameClaimTx",            Fun([String], BaseTx)},
+                     {"NameUpdateTx",           Fun([Hash], BaseTx)},
+                     {"NameRevokeTx",           Fun([Hash], BaseTx)},
+                     {"NameTransferTx",         Fun([Address, Hash], BaseTx)},
+                     {"ChannelCreateTx",        Fun([Address], BaseTx)},
+                     {"ChannelDepositTx",       Fun([Address, Int], BaseTx)},
+                     {"ChannelWithdrawTx",      Fun([Address, Int], BaseTx)},
+                     {"ChannelForceProgressTx", Fun([Address], BaseTx)},
+                     {"ChannelCloseMutualTx",   Fun([Address], BaseTx)},
+                     {"ChannelCloseSoloTx",     Fun([Address], BaseTx)},
+                     {"ChannelSlashTx",         Fun([Address], BaseTx)},
+                     {"ChannelSettleTx",        Fun([Address], BaseTx)},
+                     {"ChannelSnapshotSoloTx",  Fun([Address], BaseTx)},
+                     {"ContractCreateTx",       Fun([Int], BaseTx)},
+                     {"ContractCallTx",         Fun([Address, Int], BaseTx)},
+                     {"GAAttachTx",             BaseTx}
+                    ])
+        , types = MkDefs([{"ttl", 0}, {"tx", {[], TxType}},
+                          {"base_tx", 0},
+                          {"paying_for_tx", 0}, {"ga_meta_tx", 0}]) },
+
+    ContractScope = #scope
+        { funs = MkDefs(
+                    [{"address", Address},
+                     {"creator", Address},
+                     {"balance", Int}]) },
+
+    CallScope = #scope
+        { funs = MkDefs(
+                    [{"origin",    Address},
+                     {"caller",    Address},
+                     {"value",     Int},
+                     {"gas_price", Int},
+                     {"fee",       Int},
+                     {"gas_left",  Fun([], Int)}])
+        },
+
+    OracleScope = #scope
+        { funs = MkDefs(
+                    [{"register",     SignFun([Address, Fee, TTL], Oracle(Q, R))},
+                     {"expiry",       Fun([Oracle(Q, R)], Fee)},
+                     {"query_fee",    Fun([Oracle(Q, R)], Fee)},
+                     {"query",        StateFun([Oracle(Q, R), Q, Fee, TTL, TTL], Query(Q, R))},
+                     {"get_question", Fun([Oracle(Q, R), Query(Q, R)], Q)},
+                     {"respond",      SignFun([Oracle(Q, R), Query(Q, R), R], Unit)},
+                     {"extend",       SignFun([Oracle(Q, R), TTL], Unit)},
+                     {"get_answer",   Fun([Oracle(Q, R), Query(Q, R)], option_t(Ann, R))},
+                     {"check",        Fun([Oracle(Q, R)], Bool)},
+                     {"check_query",  Fun([Oracle(Q,R), Query(Q, R)], Bool)}]) },
+
+    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
+                      {"AccountPt",  Fun1(Address, Pointee)},
+                      {"OraclePt",   Fun1(Address, Pointee)},
+                      {"ContractPt", Fun1(Address, Pointee)},
+                      {"ChannelPt",  Fun1(Address, Pointee)},
+                      %% Name object constructor
+                      {"Name",   Fun([Address, TTL, Map(String, Pointee)], AENSName)}
+                     ])
+        , types = MkDefs([{"pointee", 0}, {"name", 0}]) },
+
+    MapScope = #scope
+        { funs = MkDefs(
+                     [{"from_list",      Fun1(List(Pair(K, V)), Map(K, V))},
+                      {"to_list",        Fun1(Map(K, V), List(Pair(K, V)))},
+                      {"lookup",         Fun([K, Map(K, V)], Option(V))},
+                      {"lookup_default", Fun([K, Map(K, V), V], V)},
+                      {"delete",         Fun([K, Map(K, V)], Map(K, V))},
+                      {"member",         Fun([K, Map(K, V)], Bool)},
+                      {"size",           Fun1(Map(K, V), Int)}]) },
+
+    %% Crypto/Curve operations
+    CryptoScope = #scope
+        { funs = MkDefs(
+                     [{"verify_sig",           Fun([Hash, Address, SignId], Bool)},
+                      {"verify_sig_secp256k1", Fun([Hash, Bytes(64), SignId], Bool)},
+                      {"ecverify_secp256k1",   Fun([Hash, Bytes(20), Bytes(65)], Bool)},
+                      {"ecrecover_secp256k1",  Fun([Hash, Bytes(65)], Option(Bytes(20)))},
+                      {"sha3",     Fun1(A, Hash)},
+                      {"sha256",   Fun1(A, Hash)},
+                      {"blake2b",  Fun1(A, Hash)}]) },
+
+    %% Fancy BLS12-381 crypto operations
+    MCL_BLS12_381_Scope = #scope
+        { funs = MkDefs(
+                     [{"g1_neg",     Fun1(G1, G1)},
+                      {"g1_norm",    Fun1(G1, G1)},
+                      {"g1_valid",   Fun1(G1, Bool)},
+                      {"g1_is_zero", Fun1(G1, Bool)},
+                      {"g1_add",     Fun ([G1, G1], G1)},
+                      {"g1_mul",     Fun ([Fr, G1], G1)},
+
+                      {"g2_neg",     Fun1(G2, G2)},
+                      {"g2_norm",    Fun1(G2, G2)},
+                      {"g2_valid",   Fun1(G2, Bool)},
+                      {"g2_is_zero", Fun1(G2, Bool)},
+                      {"g2_add",     Fun ([G2, G2], G2)},
+                      {"g2_mul",     Fun ([Fr, G2], G2)},
+
+                      {"gt_inv",      Fun1(GT, GT)},
+                      {"gt_add",      Fun ([GT, GT], GT)},
+                      {"gt_mul",      Fun ([GT, GT], GT)},
+                      {"gt_pow",      Fun ([GT, Fr], GT)},
+                      {"gt_is_one",   Fun1(GT, Bool)},
+                      {"pairing",     Fun ([G1, G2], GT)},
+                      {"miller_loop", Fun ([G1, G2], GT)},
+                      {"final_exp",   Fun1(GT, GT)},
+
+                      {"int_to_fr", Fun1(Int, Fr)},
+                      {"int_to_fp", Fun1(Int, Fp)},
+                      {"fr_to_int", Fun1(Fr, Int)},
+                      {"fp_to_int", Fun1(Fp, Int)}
+                     ]),
+          types = MkDefs(
+                     [{"fr",  0}, {"fp",  0}]) },
+
+    %% Authentication
+    AuthScope = #scope
+        { funs = MkDefs(
+                     [{"tx_hash", Option(Hash)},
+                      {"tx",      Option(Tx)}  ]) },
+
+    %% Strings
+    StringScope = #scope
+        { funs = MkDefs(
+                     [{"length",    Fun1(String, Int)},
+                      {"concat",    Fun([String, String], String)},
+                      {"to_list",   Fun1(String, List(Char))},
+                      {"from_list", Fun1(List(Char), String)},
+                      {"to_upper",  Fun1(String, String)},
+                      {"to_lower",  Fun1(String, String)},
+                      {"sha3",      Fun1(String, Hash)},
+                      {"sha256",    Fun1(String, Hash)},
+                      {"blake2b",   Fun1(String, Hash)}
+                     ]) },
+
+    %% Chars
+    CharScope = #scope
+        { funs = MkDefs(
+                     [{"to_int",   Fun1(Char, Int)},
+                      {"from_int", Fun1(Int, Option(Char))}]) },
+
+    %% Bits
+    BitsScope = #scope
+        { funs = MkDefs(
+                     [{"set",          Fun([Bits, Int], Bits)},
+                      {"clear",        Fun([Bits, Int], Bits)},
+                      {"test",         Fun([Bits, Int], Bool)},
+                      {"sum",          Fun1(Bits, Int)},
+                      {"intersection", Fun([Bits, Bits], Bits)},
+                      {"union",        Fun([Bits, Bits], Bits)},
+                      {"difference",   Fun([Bits, Bits], Bits)},
+                      {"none",         Bits},
+                      {"all",          Bits}]) },
+
+    %% Bytes
+    BytesScope = #scope
+        { funs = MkDefs(
+                   [{"to_int", Fun1(Bytes(any), Int)},
+                    {"to_str", Fun1(Bytes(any), String)},
+                    {"concat", FunC(bytes_concat, [Bytes(any), Bytes(any)], Bytes(any))},
+                    {"split",  FunC(bytes_split, [Bytes(any)], Pair(Bytes(any), Bytes(any)))}
+                   ]) },
+
+    %% Conversion
+    IntScope     = #scope{ funs = MkDefs([{"to_str", Fun1(Int,     String)}]) },
+    AddressScope = #scope{ funs = MkDefs([{"to_str", Fun1(Address, String)},
+                                          {"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
+             , ["Contract"] => ContractScope
+             , ["Call"]     => CallScope
+             , ["Oracle"]   => OracleScope
+             , ["AENS"]     => AENSScope
+             , ["Map"]      => MapScope
+             , ["Auth"]     => AuthScope
+             , ["Crypto"]   => CryptoScope
+             , ["MCL_BLS12_381"] => MCL_BLS12_381_Scope
+             , ["StringInternal"] => StringScope
+             , ["Char"]     => CharScope
+             , ["Bits"]     => BitsScope
+             , ["Bytes"]    => BytesScope
+             , ["Int"]      => IntScope
+             , ["Address"]  => AddressScope
+             }
+          , fields =
+             maps:from_list([{N, [#field_info{ ann = [], field_t = T, record_t = Tx, kind = record }]}
+                             || {N, T} <- TxFlds ])
+        }.
+
+destroy_and_report_type_errors(Env) ->
+    Errors0 = lists:reverse(aeso_tc_ets_manager:ets_tab2list(type_errors)),
+    %% io:format("Type errors now: ~p\n", [Errors0]),
+    aeso_tc_errors:destroy_type_errors(),
+    Errors  = [ aeso_tc_errors:mk_error(unqualify(Env, Err)) || Err <- Errors0 ],
+    aeso_errors:throw(Errors).  %% No-op if Errors == []
+
+%% Strip current namespace from error message for nicer printing.
+unqualify(Env, {qid, Ann, Xs}) ->
+    qid(Ann, unqualify1(aeso_tc_env:namespace(Env), Xs));
+unqualify(Env, {qcon, Ann, Xs}) ->
+    qcon(Ann, unqualify1(aeso_tc_env:namespace(Env), Xs));
+unqualify(Env, T) when is_tuple(T) ->
+    list_to_tuple(unqualify(Env, tuple_to_list(T)));
+unqualify(Env, [H | T]) -> [unqualify(Env, H) | unqualify(Env, T)];
+unqualify(_Env, X) -> X.
+
+unqualify1(NS, Xs) ->
+    try lists:split(length(NS), Xs) of
+        {NS, Ys} -> Ys;
+        _        -> Xs
+    catch _:_ -> Xs
+    end.

src/aeso_tc_errors.erl

@@ -0,0 +1,499 @@
+-module(aeso_tc_errors).
+
+-include("aeso_utils.hrl").
+
+-export([cannot_unify/4
+        , type_error/1
+        , create_type_errors/0
+        , destroy_type_errors/0
+        , mk_error/1
+        ]).
+
+%% -- Moved functions --------------------------------------------------------
+
+name(A) -> aeso_tc_name_manip:name(A).
+
+%% -------
+
+pos(A) -> aeso_tc_ann_manip:pos(A).
+pos(A, B) -> aeso_tc_ann_manip:pos(A, B).
+
+%% -------
+
+pp(A) -> aeso_tc_pp:pp(A).
+pp_type(A) -> aeso_tc_pp:pp_type(A).
+pp_type(A, B) -> aeso_tc_pp:pp_type(A, B).
+pp_typed(A, B, C) -> aeso_tc_pp:pp_typed(A, B, C).
+pp_expr(A) -> aeso_tc_pp:pp_expr(A).
+pp_why_record(A) -> aeso_tc_pp:pp_why_record(A).
+pp_when(A) -> aeso_tc_pp:pp_when(A).
+pp_loc(A) -> aeso_tc_pp:pp_loc(A).
+
+%% ---------------------------------------------------------------------------
+
+%% Save unification failures for error messages.
+cannot_unify(A, B, Cxt, When) ->
+    type_error({cannot_unify, A, B, Cxt, When}).
+
+type_error(Err) ->
+    aeso_tc_ets_manager:ets_insert(type_errors, Err).
+
+create_type_errors() ->
+    aeso_tc_ets_manager:ets_new(type_errors, [bag]).
+
+destroy_type_errors() ->
+    aeso_tc_ets_manager:ets_delete(type_errors).
+
+mk_t_err(Pos, Msg) ->
+    aeso_errors:new(type_error, Pos, lists:flatten(Msg)).
+mk_t_err(Pos, Msg, Ctxt) ->
+    aeso_errors:new(type_error, Pos, lists:flatten(Msg), lists:flatten(Ctxt)).
+
+mk_error({no_decls, File}) ->
+    Pos = aeso_errors:pos(File, 0, 0),
+    mk_t_err(Pos, "Empty contract");
+mk_error({mismatched_decl_in_funblock, Name, Decl}) ->
+    Msg = io_lib:format("Mismatch in the function block. Expected implementation/type declaration of ~s function", [Name]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({higher_kinded_typevar, T}) ->
+    Msg = io_lib:format("Type `~s` is a higher kinded type variable "
+                        "(takes another type as an argument)", [pp(aeso_tc_type_utils:instantiate(T))]
+                       ),
+    mk_t_err(pos(T), Msg);
+mk_error({wrong_type_arguments, X, ArityGiven, ArityReal}) ->
+    Msg = io_lib:format("Arity for ~s doesn't match. Expected ~p, got ~p"
+                       , [pp(aeso_tc_type_utils:instantiate(X)), ArityReal, ArityGiven]
+                       ),
+    mk_t_err(pos(X), Msg);
+mk_error({unnamed_map_update_with_default, Upd}) ->
+    Msg = "Invalid map update with default",
+    mk_t_err(pos(Upd), Msg);
+mk_error({fundecl_must_have_funtype, _Ann, Id, Type}) ->
+    Msg = io_lib:format("`~s` was declared with an invalid type `~s`. "
+                       "Entrypoints and functions must have functional types"
+                       , [pp(Id), pp(aeso_tc_type_utils:instantiate(Type))]),
+    mk_t_err(pos(Id), Msg);
+mk_error({cannot_unify, A, B, Cxt, When}) ->
+    VarianceContext = case Cxt of
+                          none -> "";
+                          _    -> io_lib:format(" in a ~p context", [Cxt])
+                      end,
+    Msg = io_lib:format("Cannot unify `~s` and `~s`" ++ VarianceContext,
+                        [pp(aeso_tc_type_utils:instantiate(A)), pp(aeso_tc_type_utils: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(aeso_tc_type_utils: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
+        {qid, _, ["Chain", "event"]} ->
+            Cxt = "Did you forget to define the event type?",
+            mk_t_err(pos(Id), Msg, Cxt);
+        _ -> mk_t_err(pos(Id), Msg)
+    end;
+mk_error({undefined_field, Id}) ->
+    Msg = io_lib:format("Unbound field ~s", [pp(Id)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({not_a_record_type, Type, Why}) ->
+    Msg = io_lib:format("Not a record type: `~s`", [pp_type(Type)]),
+    {Pos, Ctxt} = pp_why_record(Why),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({not_a_contract_type, Type, Cxt}) ->
+    Msg =
+        case Type of
+            {tvar, _, _} ->
+                "Unresolved contract type";
+            _ ->
+                io_lib:format("The type `~s` is not a contract type", [pp_type(Type)])
+        end,
+    {Pos, Cxt1} =
+        case Cxt of
+            {var_args, Ann, Fun} ->
+                {pos(Ann),
+                 io_lib:format("when calling variadic function `~s`", [pp_expr(Fun)])};
+            {contract_literal, Lit} ->
+                {pos(Lit),
+                 io_lib:format("when checking that the contract literal `~s` has the type `~s`",
+                               [pp_expr(Lit), pp_type(Type)])};
+            {address_to_contract, Ann} ->
+                {pos(Ann),
+                 io_lib:format("when checking that the call to `Address.to_contract` has the type `~s`",
+                               [pp_type(Type)])}
+        end,
+    mk_t_err(Pos, Msg, Cxt1);
+mk_error({non_linear_pattern, Pattern, Nonlinear}) ->
+    Msg = io_lib:format("Repeated name~s ~s in the pattern `~s`",
+                        [plural("", "s", Nonlinear),
+                         string:join(lists:map(fun(F) -> "`" ++ F ++ "`" end, Nonlinear), ", "),
+                         pp_expr(Pattern)]),
+    mk_t_err(pos(Pattern), Msg);
+mk_error({ambiguous_record, Fields = [{_, First} | _], Candidates}) ->
+    Msg = io_lib:format("Ambiguous record type with field~s ~s could be one of~s",
+                        [plural("", "s", Fields),
+                         string:join([ "`" ++ pp(F) ++ "`" || {_, F} <- Fields ], ", "),
+                         [ ["\n  - ", "`" ++ pp(C) ++ "`", " (at ", pp_loc(C), ")"] || C <- Candidates ]]),
+    mk_t_err(pos(First), Msg);
+mk_error({missing_field, Field, Rec}) ->
+    Msg = io_lib:format("Record type `~s` does not have field `~s`",
+                        [pp(Rec), pp(Field)]),
+    mk_t_err(pos(Field), Msg);
+mk_error({missing_fields, Ann, RecType, Fields}) ->
+    Msg = io_lib:format("The field~s ~s ~s missing when constructing an element of type `~s`",
+                        [plural("", "s", Fields),
+                         string:join(lists:map(fun(F) -> "`" ++ F ++ "`" end, Fields), ", "),
+                         plural("is", "are", Fields), pp(RecType)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({no_records_with_all_fields, Fields = [{_, First} | _]}) ->
+    Msg = io_lib:format("No record type with field~s ~s",
+                        [plural("", "s", Fields),
+                         string:join([ "`" ++ pp(F) ++ "`" || {_, F} <- Fields ], ", ")]),
+    mk_t_err(pos(First), Msg);
+mk_error({recursive_types_not_implemented, Types}) ->
+    S = plural(" is", "s are mutually", Types),
+    Msg = io_lib:format("The following type~s recursive, which is not yet supported:~s",
+                        [S, [io_lib:format("\n  - `~s` (at ~s)", [pp(T), pp_loc(T)]) || T <- Types]]),
+    mk_t_err(pos(hd(Types)), Msg);
+mk_error({event_must_be_variant_type, Where}) ->
+    Msg = io_lib:format("The event type must be a variant type", []),
+    mk_t_err(pos(Where), Msg);
+mk_error({indexed_type_must_be_word, Type, Type}) ->
+    Msg = io_lib:format("The indexed type `~s` is not a word type",
+                        [pp_type(Type)]),
+    mk_t_err(pos(Type), Msg);
+mk_error({indexed_type_must_be_word, Type, Type1}) ->
+    Msg = io_lib:format("The indexed type `~s` equals `~s` which is not a word type",
+                        [pp_type(Type), pp_type(Type1)]),
+    mk_t_err(pos(Type), Msg);
+mk_error({event_0_to_3_indexed_values, Constr}) ->
+    Msg = io_lib:format("The event constructor `~s` has too many indexed values (max 3)",
+                        [name(Constr)]),
+    mk_t_err(pos(Constr), Msg);
+mk_error({event_0_to_1_string_values, Constr}) ->
+    Msg = io_lib:format("The event constructor `~s` has too many non-indexed values (max 1)",
+                        [name(Constr)]),
+    mk_t_err(pos(Constr), Msg);
+mk_error({repeated_constructor, Cs}) ->
+    Msg = io_lib:format("Variant types must have distinct constructor names~s",
+                        [[ io_lib:format("\n`~s`  (at ~s)", [pp_typed("  - ", C, T), pp_loc(C)]) || {C, T} <- Cs ]]),
+    mk_t_err(pos(element(1, hd(Cs))), Msg);
+mk_error({bad_named_argument, [], Name}) ->
+    Msg = io_lib:format("Named argument ~s supplied to function expecting no named arguments.",
+                        [pp(Name)]),
+    mk_t_err(pos(Name), Msg);
+mk_error({bad_named_argument, Args, Name}) ->
+    Msg = io_lib:format("Named argument `~s` is not one of the expected named arguments~s",
+                        [pp(Name),
+                        [ io_lib:format("\n  - `~s`", [pp_typed("", Arg, Type)])
+                          || {named_arg_t, _, Arg, Type, _} <- Args ]]),
+    mk_t_err(pos(Name), Msg);
+mk_error({unsolved_named_argument_constraint, Name, Type}) ->
+    Msg = io_lib:format("Named argument ~s supplied to function with unknown named arguments.",
+                        [pp_typed("", Name, Type)]),
+    mk_t_err(pos(Name), Msg);
+mk_error({reserved_entrypoint, Name, Def}) ->
+    Msg = io_lib:format("The name '~s' is reserved and cannot be used for a "
+                        "top-level contract function.", [Name]),
+    mk_t_err(pos(Def), Msg);
+mk_error({duplicate_definition, Name, Locs}) ->
+    Msg = io_lib:format("Duplicate definitions of `~s` at~s",
+                        [Name, [ ["\n  - ", pp_loc(L)] || L <- Locs ]]),
+    mk_t_err(pos(lists:last(Locs)), Msg);
+mk_error({duplicate_scope, Kind, Name, OtherKind, L}) ->
+    Msg = io_lib:format("The ~p `~s` has the same name as a ~p at ~s",
+                        [Kind, pp(Name), OtherKind, pp_loc(L)]),
+    mk_t_err(pos(Name), Msg);
+mk_error({include, _, {string, Pos, Name}}) ->
+    Msg = io_lib:format("Include of `~s` is not allowed, include only allowed at top level.",
+                        [binary_to_list(Name)]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({namespace, _Pos, {con, Pos, Name}, _Def}) ->
+    Msg = io_lib:format("Nested namespaces are not allowed. Namespace `~s` is not defined at top level.",
+                        [Name]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({Contract, _Pos, {con, Pos, Name}, _Impls, _Def}) when ?IS_CONTRACT_HEAD(Contract) ->
+    Msg = io_lib:format("Nested contracts are not allowed. Contract `~s` is not defined at top level.",
+                        [Name]),
+    mk_t_err(pos(Pos), Msg);
+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({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)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({stateful_not_allowed_in_guards, Id}) ->
+    Msg = io_lib:format("Cannot reference stateful function `~s` in a pattern guard.",
+                        [pp(Id)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({value_arg_not_allowed, Value, Fun}) ->
+    Msg = io_lib:format("Cannot pass non-zero value argument `~s` in the definition of non-stateful function `~s`.",
+                        [pp_expr(Value), pp(Fun)]),
+    mk_t_err(pos(Value), Msg);
+mk_error({init_depends_on_state, Which, [_Init | Chain]}) ->
+    WhichCalls = fun("put") -> ""; ("state") -> ""; (_) -> ", which calls" end,
+    Msg = io_lib:format("The `init` function should return the initial state as its result and cannot ~s the state, but it calls~s",
+                        [if Which == put -> "write"; true -> "read" end,
+                         [ io_lib:format("\n  - `~s` (at ~s)~s", [Fun, pp_loc(Ann), WhichCalls(Fun)])
+                           || {[_, Fun], Ann} <- Chain]]),
+    mk_t_err(pos(element(2, hd(Chain))), Msg);
+mk_error({missing_body_for_let, Ann}) ->
+    Msg = io_lib:format("Let binding must be followed by an expression.", []),
+    mk_t_err(pos(Ann), Msg);
+mk_error({public_modifier_in_contract, Decl}) ->
+    Decl1 = mk_entrypoint(Decl),
+    Msg = io_lib:format("Use `entrypoint` instead of `function` for public function `~s`: `~s`",
+                        [pp_expr(element(3, Decl)),
+                         prettypr:format(aeso_pretty:decl(Decl1))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({init_must_be_an_entrypoint, Decl}) ->
+    Decl1 = mk_entrypoint(Decl),
+    Msg = io_lib:format("The init function must be an entrypoint: ~s",
+                        [prettypr:format(prettypr:nest(2, aeso_pretty:decl(Decl1)))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({init_must_not_be_payable, Decl}) ->
+    Msg = io_lib:format("The init function cannot be payable. "
+                        "You don't need the 'payable' annotation to be able to attach "
+                        "funds to the create contract transaction.",
+                        []),
+    mk_t_err(pos(Decl), Msg);
+mk_error({proto_must_be_entrypoint, Decl}) ->
+    Decl1 = mk_entrypoint(Decl),
+    Msg = io_lib:format("Use `entrypoint` for declaration of `~s`: `~s`",
+                        [pp_expr(element(3, Decl)),
+                         prettypr:format(aeso_pretty:decl(Decl1))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({proto_in_namespace, Decl}) ->
+    Msg = io_lib:format("Namespaces cannot contain function prototypes.", []),
+    mk_t_err(pos(Decl), Msg);
+mk_error({entrypoint_in_namespace, Decl}) ->
+    Msg = io_lib:format("Namespaces cannot contain entrypoints. Use `function` instead.", []),
+    mk_t_err(pos(Decl), Msg);
+mk_error({private_entrypoint, Decl}) ->
+    Msg = io_lib:format("The entrypoint `~s` cannot be private. Use `function` instead.",
+                        [pp_expr(element(3, Decl))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({private_and_public, Decl}) ->
+    Msg = io_lib:format("The function `~s` cannot be both public and private.",
+                        [pp_expr(element(3, Decl))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({contract_has_no_entrypoints, Con}) ->
+    Msg = io_lib:format("The contract `~s` has no entrypoints. Since Sophia version 3.2, public "
+                        "contract functions must be declared with the `entrypoint` keyword instead of "
+                        "`function`.", [pp_expr(Con)]),
+    mk_t_err(pos(Con), Msg);
+mk_error({definition_in_contract_interface, Ann, {id, _, Id}}) ->
+    Msg = "Contract interfaces cannot contain defined functions or entrypoints.",
+    Cxt = io_lib:format("Fix: replace the definition of `~s` by a type signature.", [Id]),
+    mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({unbound_type, Type}) ->
+    Msg = io_lib:format("Unbound type ~s.", [pp_type(Type)]),
+    mk_t_err(pos(Type), Msg);
+mk_error({new_tuple_syntax, Ann, Ts}) ->
+    Msg = io_lib:format("Invalid type `~s`. The syntax of tuple types changed in Sophia version 4.0. Did you mean `~s`",
+                        [pp_type({args_t, Ann, Ts}), pp_type({tuple_t, Ann, Ts})]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({map_in_map_key, Ann, KeyType}) ->
+    Msg = io_lib:format("Invalid key type `~s`", [pp_type(KeyType)]),
+    Cxt = "Map keys cannot contain other maps.",
+    mk_t_err(pos(Ann), Msg, Cxt);
+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_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";
+               _      -> "contract or namespace"
+           end,
+    Id = element(3, Decl),
+    Msg = io_lib:format("The definition of '~s' must appear inside a ~s.",
+                        [pp_expr(Id), What]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({unknown_byte_length, Type}) ->
+    Msg = io_lib:format("Cannot resolve length of byte array.", []),
+    mk_t_err(pos(Type), Msg);
+mk_error({unsolved_bytes_constraint, Ann, concat, A, B, C}) ->
+    Msg = io_lib:format("Failed to resolve byte array lengths in call to Bytes.concat with arguments of type\n"
+                        "~s  (at ~s)\n~s  (at ~s)\nand result type\n~s  (at ~s)",
+                        [pp_type("  - ", A), pp_loc(A), pp_type("  - ", B),
+                         pp_loc(B), pp_type("  - ", C), pp_loc(C)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({unsolved_bytes_constraint, Ann, split, A, B, C}) ->
+    Msg = io_lib:format("Failed to resolve byte array lengths in call to Bytes.split with argument of type\n"
+                        "~s  (at ~s)\nand result types\n~s  (at ~s)\n~s  (at ~s)",
+                        [ pp_type("  - ", C), pp_loc(C), pp_type("  - ", A), pp_loc(A),
+                          pp_type("  - ", B), pp_loc(B)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({failed_to_get_compiler_version, Err}) ->
+    Msg = io_lib:format("Failed to get compiler version. Error: ~p", [Err]),
+    mk_t_err(pos(0, 0), Msg);
+mk_error({compiler_version_mismatch, Ann, Version, Op, Bound}) ->
+    PrintV = fun(V) -> string:join([integer_to_list(N) || N <- V], ".") end,
+    Msg = io_lib:format("Cannot compile with this version of the compiler, "
+                        "because it does not satisfy the constraint"
+                        " ~s ~s ~s", [PrintV(Version), Op, PrintV(Bound)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({empty_record_or_map_update, Expr}) ->
+    Msg = io_lib:format("Empty record/map update `~s`", [pp_expr(Expr)]),
+    mk_t_err(pos(Expr), Msg);
+mk_error({mixed_record_and_map, Expr}) ->
+    Msg = io_lib:format("Mixed record fields and map keys in `~s`", [pp_expr(Expr)]),
+    mk_t_err(pos(Expr), Msg);
+mk_error({named_argument_must_be_literal_bool, Name, Arg}) ->
+    Msg = io_lib:format("Invalid `~s` argument `~s`. "
+                        "It must be either `true` or `false`.",
+                        [Name, pp_expr(aeso_tc_type_utils:instantiate(Arg))]),
+    mk_t_err(pos(Arg), Msg);
+mk_error({conflicting_updates_for_field, Upd, Key}) ->
+    Msg = io_lib:format("Conflicting updates for field '~s'", [Key]),
+    mk_t_err(pos(Upd), Msg);
+mk_error({ambiguous_main_contract, Ann}) ->
+    Msg = "Could not deduce the main contract. You can point it out manually with the `main` keyword.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({main_contract_undefined, Ann}) ->
+    Msg = "No contract defined.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({multiple_main_contracts, Ann}) ->
+    Msg = "Only one main contract can be defined.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({unify_varargs, When}) ->
+    Msg = "Cannot infer types for variable argument list.",
+    {Pos, Ctxt} = pp_when(When),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({clone_no_contract, Ann}) ->
+    Msg = "Chain.clone requires `ref` named argument of contract type.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({contract_lacks_definition, Type, When}) ->
+    Msg = io_lib:format(
+            "~s is not implemented.",
+            [pp_type(Type)]
+           ),
+    {Pos, Ctxt} = pp_when(When),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({ambiguous_name, Name, QIds}) ->
+    Msg = io_lib:format("Ambiguous name `~s` could be one of~s",
+                        [pp(Name),
+                         [io_lib:format("\n  - `~s` (at ~s)", [pp(QId), pp_loc(QId)]) || QId <- QIds]]),
+    mk_t_err(pos(Name), Msg);
+mk_error({using_undefined_namespace, Ann, Namespace}) ->
+    Msg = io_lib:format("Cannot use undefined namespace ~s", [Namespace]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({using_undefined_namespace_parts, Ann, Namespace, Parts}) ->
+    PartsStr = lists:concat(lists:join(", ", Parts)),
+    Msg = io_lib:format("The namespace ~s does not define the following names: ~s", [Namespace, PartsStr]),
+    mk_t_err(pos(Ann), Msg);
+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 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)]),
+    mk_t_err(pos(InterfaceId), Msg);
+mk_error({missing_definition, Id}) ->
+    Msg = io_lib:format("Missing definition of function `~s`", [name(Id)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({parameterized_state, Ann}) ->
+    Msg = "The state type cannot be parameterized",
+    mk_t_err(pos(Ann), Msg);
+mk_error({parameterized_event, Ann}) ->
+    Msg = "The event type cannot be parameterized",
+    mk_t_err(pos(Ann), Msg);
+mk_error({missing_init_function, Con}) ->
+    Msg = io_lib:format("Missing `init` function for the contract `~s`.", [name(Con)]),
+    Cxt = "The `init` function can only be omitted if the state type is `unit`",
+    mk_t_err(pos(Con), Msg, Cxt);
+mk_error({higher_order_entrypoint, Ann, {id, _, Name}, Thing}) ->
+    What = "higher-order (contains function types)",
+    ThingS = case Thing of
+                 {argument, X, T} -> io_lib:format("argument\n~s`\n", [pp_typed("  `", X, T)]);
+                 {result, T}      -> io_lib:format("return type\n~s`\n", [pp_type("  `", T)])
+             end,
+    Bad = case Thing of
+              {argument, _, _} -> io_lib:format("has a ~s type", [What]);
+              {result, _}      -> io_lib:format("is ~s", [What])
+          end,
+    Msg = io_lib:format("The ~sof entrypoint `~s` ~s",
+                        [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"
+                        "~s`\n"
+                        "It must be a `string` or a pubkey type (`address`, `oracle`, etc)",
+                        [pp_type("  `", T)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({invalid_oracle_type, Why, What, Ann, Type}) ->
+    WhyS = case Why of higher_order -> "higher-order (contain function types)";
+                       polymorphic  -> "polymorphic (contain type variables)" end,
+    Msg = io_lib:format("Invalid oracle type\n~s`", [pp_type("  `", Type)]),
+    Cxt = io_lib:format("The ~s type must not be ~s", [What, WhyS]),
+    mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({interface_implementation_conflict, Contract, I1, I2, Fun}) ->
+    Msg = io_lib:format("Both interfaces `~s` and `~s` implemented by "
+                        "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).
+
+mk_entrypoint(Decl) ->
+    Ann   = [entrypoint | lists:keydelete(public, 1,
+                          lists:keydelete(private, 1,
+                            aeso_syntax:get_ann(Decl))) -- [public, private]],
+    aeso_syntax:set_ann(Ann, Decl).
+
+plural(No, _Yes, [_]) -> No;
+plural(_No, Yes, _)   -> Yes.

src/aeso_tc_ets_manager.erl

@@ -0,0 +1,102 @@
+-module(aeso_tc_ets_manager).
+
+-export([ ets_init/0
+        , ets_new/2
+        , ets_lookup/2
+        , ets_insert/2
+        , ets_insert_new/2
+        , ets_insert_ordered/2
+        , ets_delete/1
+        , ets_delete/2
+        , ets_match_delete/2
+        , ets_tab2list/1
+        , ets_tab2list_ordered/1
+        , ets_tab_exists/1
+        , clean_up_ets/0
+        ]).
+
+%% Clean up all the ets tables (in case of an exception)
+
+ets_tables() ->
+    [options, type_vars, constraints, freshen_tvars, type_errors,
+     defined_contracts, warnings, function_calls, all_functions,
+     type_vars_variance, functions_to_implement].
+
+clean_up_ets() ->
+    [ catch ets_delete(Tab) || Tab <- ets_tables() ],
+    ok.
+
+%% Named interface to ETS tables implemented without names.
+%% The interface functions behave as the standard ETS interface.
+
+ets_init() ->
+    put(aeso_ast_infer_types, #{}).
+
+ets_tab_exists(Name) ->
+    Tabs = get(aeso_ast_infer_types),
+    case maps:find(Name, Tabs) of
+        {ok, _} -> true;
+        error   -> false
+    end.
+
+ets_tabid(Name) ->
+    #{Name := TabId} = get(aeso_ast_infer_types),
+    TabId.
+
+ets_new(Name, Opts) ->
+    %% Ensure the table is NOT named!
+    TabId = ets:new(Name, Opts -- [named_table]),
+    Tabs = get(aeso_ast_infer_types),
+    put(aeso_ast_infer_types, Tabs#{Name => TabId}),
+    Name.
+
+ets_delete(Name) ->
+    Tabs = get(aeso_ast_infer_types),
+    #{Name := TabId} = Tabs,
+    put(aeso_ast_infer_types, maps:remove(Name, Tabs)),
+    ets:delete(TabId).
+
+ets_delete(Name, Key) ->
+    TabId = ets_tabid(Name),
+    ets:delete(TabId, Key).
+
+ets_insert(Name, Object) ->
+    TabId = ets_tabid(Name),
+    ets:insert(TabId, Object).
+
+ets_insert_new(Name, Object) ->
+    TabId = ets_tabid(Name),
+    ets:insert_new(TabId, Object).
+
+ets_lookup(Name, Key) ->
+    TabId = ets_tabid(Name),
+    ets:lookup(TabId, Key).
+
+ets_match_delete(Name, Pattern) ->
+    TabId = ets_tabid(Name),
+    ets:match_delete(TabId, Pattern).
+
+ets_tab2list(Name) ->
+    TabId = ets_tabid(Name),
+    ets:tab2list(TabId).
+
+ets_insert_ordered(_, []) -> true;
+ets_insert_ordered(Name, [H|T]) ->
+    ets_insert_ordered(Name, H),
+    ets_insert_ordered(Name, T);
+ets_insert_ordered(Name, Object) ->
+    Count = next_count(),
+    TabId = ets_tabid(Name),
+    ets:insert(TabId, {Count, Object}).
+
+ets_tab2list_ordered(Name) ->
+    [E || {_, E} <- ets_tab2list(Name)].
+
+next_count() ->
+    V = case get(counter) of
+            undefined ->
+                0;
+            X -> X
+        end,
+    put(counter, V + 1),
+    V.

src/aeso_tc_name_manip.erl

@@ -0,0 +1,39 @@
+-module(aeso_tc_name_manip).
+
+-export([ name/1
+        , qname/1
+        , qid/2
+        , qcon/2
+        , set_qname/2
+        ]).
+
+%% TODO: types are duplicated
+-type name() :: string().
+-type qname() :: [string()].
+-type type_id() :: aeso_syntax:id() | aeso_syntax:qid() | aeso_syntax:con() | aeso_syntax:qcon().
+
+-spec qname(type_id()) -> qname().
+qname({id,   _, X})  -> [X];
+qname({qid,  _, Xs}) -> Xs;
+qname({con,  _, X})  -> [X];
+qname({qcon, _, Xs}) -> Xs.
+
+-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};
+qid(Ann, Xs)  -> {qid, Ann, Xs}.
+
+-spec qcon(aeso_syntax:ann(), qname()) -> aeso_syntax:con() | aeso_syntax:qcon().
+qcon(Ann, [X]) -> {con, Ann, X};
+qcon(Ann, Xs)  -> {qcon, Ann, Xs}.
+
+-spec set_qname(qname(), type_id()) -> type_id().
+set_qname(Xs, {id,   Ann, _}) -> qid(Ann, Xs);
+set_qname(Xs, {qid,  Ann, _}) -> qid(Ann, Xs);
+set_qname(Xs, {con,  Ann, _}) -> qcon(Ann, Xs);
+set_qname(Xs, {qcon, Ann, _}) -> qcon(Ann, Xs).

src/aeso_tc_options.erl

@@ -0,0 +1,48 @@
+-module(aeso_tc_options).
+
+-export([ create_options/1
+        , get_option/2
+        , when_option/2
+        , when_warning/2
+        ]).
+
+%% -- Moved functions --------------------------------------------------------
+
+all_warnings() -> aeso_tc_warnings:all_warnings().
+
+%% ---------------------------------------------------------------------------
+
+create_options(Options) ->
+    aeso_tc_ets_manager:ets_new(options, [set]),
+    Tup = fun(Opt) when is_atom(Opt) -> {Opt, true};
+             (Opt) when is_tuple(Opt) -> Opt end,
+    aeso_tc_ets_manager:ets_insert(options, lists:map(Tup, Options)).
+
+get_option(Key, Default) ->
+    case aeso_tc_ets_manager:ets_lookup(options, Key) of
+        [{_Key, Val}] -> Val;
+        _             -> Default
+    end.
+
+when_option(Opt, Do) ->
+    get_option(Opt, false) andalso Do().
+
+when_warning(Warn, Do) ->
+    case lists:member(Warn, all_warnings()) of
+        false ->
+            %% TODO: An error for passing invalid wanring name should be thrown here.
+            %%       Validation of compiler options might be done at an earlier stage.
+            ok;
+        true ->
+            case aeso_tc_ets_manager:ets_tab_exists(warnings) of
+                true ->
+                    IsEnabled = get_option(Warn, false),
+                    IsAll = get_option(warn_all, false) andalso lists:member(Warn, all_warnings()),
+                    if
+                        IsEnabled orelse IsAll -> Do();
+                        true -> ok
+                    end;
+                false ->
+                    ok
+            end
+    end.

src/aeso_tc_pp.erl

@@ -0,0 +1,248 @@
+-module(aeso_tc_pp).
+
+-export([ pp/1
+        , pp_type/1
+        , pp_type/2
+        , pp_typed/3
+        , pp_expr/1
+        , pp_why_record/1
+        , pp_loc/1
+        , pp_when/1
+        ]).
+
+%% -- Duplicated types -------------------------------------------------------
+
+-type why_record() :: aeso_syntax:field(aeso_syntax:expr())
+                    | {var_args, aeso_syntax:ann(), aeso_syntax:expr()}
+                    | {proj, aeso_syntax:ann(), aeso_syntax:expr(), aeso_syntax:id()}.
+
+%% -- Moved functions --------------------------------------------------------
+
+pos(A) -> aeso_tc_ann_manip:pos(A).
+pos(A, B) -> aeso_tc_ann_manip:pos(A, B).
+loc(A) -> aeso_tc_ann_manip:loc(A).
+
+%% ---------------------------------------------------------------------------
+
+-type pos() :: aeso_errors:pos().
+
+if_branches(If = {'if', Ann, _, Then, Else}) ->
+    case proplists:get_value(format, Ann) of
+        elif -> [Then | if_branches(Else)];
+        _    -> [If]
+    end;
+if_branches(E) -> [E].
+
+pp_when({todo, What}) -> {pos(0, 0), io_lib:format("[TODO] ~p", [What])};
+pp_when({at, Ann}) -> {pos(Ann), io_lib:format("at ~s", [pp_loc(Ann)])};
+pp_when({check_typesig, Name, Inferred, Given}) ->
+    {pos(Given),
+     io_lib:format("when checking the definition of `~s`\n"
+                   "  inferred type: `~s`\n"
+                   "  given type:    `~s`",
+         [Name, pp(aeso_tc_type_utils:instantiate(Inferred)), pp(aeso_tc_type_utils:instantiate(Given))])};
+pp_when({infer_app, Fun, NamedArgs, Args, Inferred0, ArgTypes0}) ->
+    Inferred = aeso_tc_type_utils:instantiate(Inferred0),
+    ArgTypes = aeso_tc_type_utils:instantiate(ArgTypes0),
+    {pos(Fun),
+     io_lib:format("when checking the application of\n"
+                   "  `~s`\n"
+                   "to arguments~s",
+                   [pp_typed("", Fun, Inferred),
+                    [ ["\n  ", "`" ++ pp_expr(NamedArg) ++ "`"] || NamedArg <- NamedArgs ] ++
+                    [ ["\n  ", "`" ++ pp_typed("", Arg, ArgT) ++ "`"]
+                       || {Arg, ArgT} <- lists:zip(Args, ArgTypes) ] ])};
+pp_when({field_constraint, FieldType0, InferredType0, Fld}) ->
+    FieldType    = aeso_tc_type_utils:instantiate(FieldType0),
+    InferredType = aeso_tc_type_utils:instantiate(InferredType0),
+    {pos(Fld),
+     case Fld of
+         {var_args, _Ann, _Fun} ->
+             io_lib:format("when checking contract construction of type\n~s (at ~s)\nagainst the expected type\n~s\n",
+                          [pp_type("  ", FieldType),
+                           pp_loc(Fld),
+                           pp_type("  ", InferredType)
+                          ]);
+         {field, _Ann, LV, Id, E} ->
+             io_lib:format("when checking the assignment of the field `~s` to the old value `~s` and the new value `~s`",
+                 [pp_typed("", {lvalue, [], LV}, FieldType),
+                  pp(Id),
+                  pp_typed("", E, InferredType)]);
+         {field, _Ann, LV, E} ->
+             io_lib:format("when checking the assignment of the field `~s` to the value `~s`",
+                 [pp_typed("", {lvalue, [], LV}, FieldType),
+                  pp_typed("", E, InferredType)]);
+         {proj, _Ann, _Rec, _Fld} ->
+             io_lib:format("when checking the record projection `~s` against the expected type `~s`",
+                 [pp_typed("  ", Fld, FieldType),
+                  pp_type("  ", InferredType)])
+     end};
+pp_when({record_constraint, RecType0, InferredType0, Fld}) ->
+    RecType      = aeso_tc_type_utils:instantiate(RecType0),
+    InferredType = aeso_tc_type_utils:instantiate(InferredType0),
+    {Pos, WhyRec} = pp_why_record(Fld),
+    case Fld of
+        {var_args, _Ann, _Fun} ->
+            {Pos,
+             io_lib:format("when checking that contract construction of type\n~s\n~s\n"
+                           "matches the expected type\n~s",
+                           [pp_type("  ", RecType), WhyRec, pp_type("  ", InferredType)]
+                          )
+            };
+        {field, _Ann, _LV, _Id, _E} ->
+            {Pos,
+             io_lib:format("when checking that the record type\n~s\n~s\n"
+                           "matches the expected type\n~s",
+                 [pp_type("  ", RecType), WhyRec, pp_type("  ", InferredType)])};
+        {field, _Ann, _LV, _E} ->
+            {Pos,
+             io_lib:format("when checking that the record type\n~s\n~s\n"
+                           "matches the expected type\n~s",
+                 [pp_type("  ", RecType), WhyRec, pp_type("  ", InferredType)])};
+        {proj, _Ann, Rec, _FldName} ->
+            {pos(Rec),
+             io_lib:format("when checking that the expression\n~s (at ~s)\nhas type\n~s\n~s",
+                 [pp_typed("  ", Rec, InferredType), pp_loc(Rec),
+                  pp_type("  ", RecType), WhyRec])}
+    end;
+pp_when({if_branches, Then, ThenType0, Else, ElseType0}) ->
+    {ThenType, ElseType} = aeso_tc_type_utils:instantiate({ThenType0, ElseType0}),
+    Branches = [ {Then, ThenType} | [ {B, ElseType} || B <- if_branches(Else) ] ],
+    {pos(element(1, hd(Branches))),
+     io_lib:format("when comparing the types of the if-branches\n"
+                   "~s", [ [ io_lib:format("~s (at ~s)\n", [pp_typed("  - ", B, BType), pp_loc(B)])
+                           || {B, BType} <- Branches ] ])};
+pp_when({case_pat, Pat, PatType0, ExprType0}) ->
+    {PatType, ExprType} = aeso_tc_type_utils:instantiate({PatType0, ExprType0}),
+    {pos(Pat),
+     io_lib:format("when checking the type of the pattern `~s` against the expected type `~s`",
+                   [pp_typed("", Pat, PatType),
+                    pp_type(ExprType)])};
+pp_when({check_expr, Expr, Inferred0, Expected0}) ->
+    {Inferred, Expected} = aeso_tc_type_utils:instantiate({Inferred0, Expected0}),
+    {pos(Expr),
+     io_lib:format("when checking the type of the expression `~s` against the expected type `~s`",
+                   [pp_typed("", Expr, Inferred), pp_type(Expected)])};
+pp_when({checking_init_type, Ann}) ->
+    {pos(Ann),
+     io_lib:format("when checking that `init` returns a value of type `state`", [])};
+pp_when({list_comp, BindExpr, Inferred0, Expected0}) ->
+    {Inferred, Expected} = aeso_tc_type_utils:instantiate({Inferred0, Expected0}),
+    {pos(BindExpr),
+     io_lib:format("when checking rvalue of list comprehension binding `~s` against type `~s`",
+                   [pp_typed("", BindExpr, Inferred), pp_type(Expected)])};
+pp_when({check_named_arg_constraint, CArgs, CName, CType}) ->
+    {id, _, Name} = Arg = CName,
+    [Type | _] = [ Type || {named_arg_t, _, {id, _, Name1}, Type, _} <- CArgs, Name1 == Name ],
+    Err = io_lib:format("when checking named argument `~s` against inferred type `~s`",
+                        [pp_typed("", Arg, Type), pp_type(CType)]),
+    {pos(Arg), Err};
+pp_when({checking_init_args, Ann, Con0, ArgTypes0}) ->
+    Con = aeso_tc_type_utils:instantiate(Con0),
+    ArgTypes = aeso_tc_type_utils:instantiate(ArgTypes0),
+    {pos(Ann),
+     io_lib:format("when checking arguments of `~s`'s init entrypoint to match\n(~s)",
+                   [pp_type(Con), string:join([pp_type(A) || A <- ArgTypes], ", ")])
+    };
+pp_when({return_contract, App, Con0}) ->
+    Con = aeso_tc_type_utils:instantiate(Con0),
+    {pos(App)
+    , io_lib:format("when checking that expression returns contract of type `~s`", [pp_type(Con)])
+    };
+pp_when({arg_name, Id1, Id2, When}) ->
+    {Pos, Ctx} = pp_when(When),
+    {Pos
+    , io_lib:format("when unifying names of named arguments: `~s` and `~s`\n~s", [pp_expr(Id1), pp_expr(Id2), Ctx])
+    };
+pp_when({var_args, Ann, Fun}) ->
+    {pos(Ann)
+    , io_lib:format("when resolving arguments of variadic function `~s`", [pp_expr(Fun)])
+    };
+pp_when(unknown) -> {pos(0,0), ""}.
+
+-spec pp_why_record(why_record()) -> {pos(), iolist()}.
+pp_why_record({var_args, Ann, Fun}) ->
+    {pos(Ann),
+     io_lib:format("arising from resolution of variadic function `~s`",
+                   [pp_expr(Fun)])};
+pp_why_record(Fld = {field, _Ann, LV, _E}) ->
+    {pos(Fld),
+     io_lib:format("arising from an assignment of the field `~s`",
+                   [pp_expr({lvalue, [], LV})])};
+pp_why_record(Fld = {field, _Ann, LV, _Alias, _E}) ->
+    {pos(Fld),
+     io_lib:format("arising from an assignment of the field `~s`",
+                   [pp_expr({lvalue, [], LV})])};
+pp_why_record({proj, _Ann, Rec, FldName}) ->
+    {pos(Rec),
+     io_lib:format("arising from the projection of the field `~s`",
+         [pp(FldName)])}.
+
+pp_typed(Label, E, T = {type_sig, _, _, _, _, _}) -> pp_typed(Label, E, aeso_tc_type_utils:typesig_to_fun_t(T));
+pp_typed(Label, {typed, _, Expr, _}, Type) ->
+    pp_typed(Label, Expr, Type);
+pp_typed(Label, Expr, Type) ->
+    pp_expr(Label, {typed, [], Expr, Type}).
+
+pp_expr(Expr) ->
+    pp_expr("", Expr).
+pp_expr(Label, Expr) ->
+    prettypr:format(prettypr:beside(prettypr:text(Label), aeso_pretty:expr(Expr, [show_generated])), 80, 80).
+
+pp_type(Type) ->
+    pp_type("", Type).
+pp_type(Label, Type) ->
+    prettypr:format(prettypr:beside(prettypr:text(Label), aeso_pretty:type(Type, [show_generated])), 80, 80).
+
+pp_loc(T) ->
+    {File, IncludeType, Line, Col} = loc(T),
+    case {Line, Col} of
+        {0, 0} -> "(builtin location)";
+        _      -> case IncludeType of
+                      none -> io_lib:format("line ~p, column ~p", [Line, Col]);
+                      _    -> io_lib:format("line ~p, column ~p in ~s", [Line, Col, File])
+                  end
+    end.
+
+pp(T = {type_sig, _, _, _, _, _}) ->
+    pp(aeso_tc_type_utils:typesig_to_fun_t(T));
+pp([]) ->
+    "";
+pp([T]) ->
+    pp(T);
+pp([T|Ts]) ->
+    [pp(T), ", "|pp(Ts)];
+pp({id, _, Name}) ->
+    Name;
+pp({qid, _, Name}) ->
+    string:join(Name, ".");
+pp({con, _, Name}) ->
+    Name;
+pp({qcon, _, Name}) ->
+    string:join(Name, ".");
+pp({uvar, _, Ref}) ->
+    %% Show some unique representation
+    ["?u" | integer_to_list(erlang:phash2(Ref, 16384)) ];
+pp({tvar, _, Name}) ->
+    Name;
+pp({if_t, _, Id, Then, Else}) ->
+    ["if(", pp([Id, Then, Else]), ")"];
+pp({tuple_t, _, []}) ->
+    "unit";
+pp({tuple_t, _, Cpts}) ->
+    ["(", string:join(lists:map(fun pp/1, Cpts), " * "), ")"];
+pp({bytes_t, _, any}) -> "bytes(_)";
+pp({bytes_t, _, Len}) ->
+    ["bytes(", integer_to_list(Len), ")"];
+pp({app_t, _, T, []}) ->
+    pp(T);
+pp({app_t, _, Type, Args}) ->
+    [pp(Type), "(", pp(Args), ")"];
+pp({named_arg_t, _, Name, Type, _Default}) ->
+    [pp(Name), " : ", pp(Type)];
+pp({fun_t, _, Named = {uvar, _, _}, As, B}) ->
+    ["(", pp(Named), " | ", pp(As), ") => ", pp(B)];
+pp({fun_t, _, Named, As, B}) when is_list(Named) ->
+    ["(", pp(Named ++ As), ") => ", pp(B)];
+pp(Other) ->
+    io_lib:format("~p", [Other]).

src/aeso_tc_type_unfolding.erl

@@ -0,0 +1,134 @@
+-module(aeso_tc_type_unfolding).
+
+-export([ unfold_types_in_type/2
+        , unfold_types_in_type/3
+        , unfold_record_types/2
+        ]).
+
+%% -- Duplicated macros ------------------------------------------------------
+
+-define(is_type_id(T), element(1, T) =:= id orelse
+                       element(1, T) =:= qid orelse
+                       element(1, T) =:= con orelse
+                       element(1, T) =:= qcon).
+
+%% -- Moved functions --------------------------------------------------------
+
+type_error(A) -> aeso_tc_errors:type_error(A).
+
+%% -------
+
+used_typedef(A, B) -> aeso_tc_warnings:used_typedef(A, B).
+
+%% -------
+
+when_warning(A, B) -> aeso_tc_options:when_warning(A, B).
+
+%% ---------------------------------------------------------------------------
+
+%% During type inference, record types are represented by their
+%% names. But, before we pass the typed program to the code generator,
+%% we replace record types annotating expressions with their
+%% definition. This enables the code generator to see the fields.
+unfold_record_types(Env, T) ->
+    unfold_types(Env, T, [unfold_record_types]).
+
+unfold_types(Env, {typed, Attr, E, Type}, Options) ->
+    Options1 = [{ann, Attr} | lists:keydelete(ann, 1, Options)],
+    {typed, Attr, unfold_types(Env, E, Options), unfold_types_in_type(Env, Type, Options1)};
+unfold_types(Env, {arg, Attr, Id, Type}, Options) ->
+    {arg, Attr, Id, unfold_types_in_type(Env, Type, Options)};
+unfold_types(Env, {type_sig, Ann, Constr, NamedArgs, Args, Ret}, Options) ->
+    {type_sig, Ann, Constr,
+               unfold_types_in_type(Env, NamedArgs, Options),
+               unfold_types_in_type(Env, Args, Options),
+               unfold_types_in_type(Env, Ret, Options)};
+unfold_types(Env, {type_def, Ann, Name, Args, Def}, Options) ->
+    {type_def, Ann, Name, Args, unfold_types_in_type(Env, Def, Options)};
+unfold_types(Env, {fun_decl, Ann, Name, Type}, Options) ->
+    {fun_decl, Ann, Name, unfold_types(Env, Type, Options)};
+unfold_types(Env, {letfun, Ann, Name, Args, Type, [{guarded, AnnG, [], Body}]}, Options) ->
+    {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), [{guarded, AnnG, [], unfold_types(Env, Body, Options)}]};
+unfold_types(Env, T, Options) when is_tuple(T) ->
+    list_to_tuple(unfold_types(Env, tuple_to_list(T), Options));
+unfold_types(Env, [H|T], Options) ->
+    [unfold_types(Env, H, Options)|unfold_types(Env, T, Options)];
+unfold_types(_Env, X, _Options) ->
+    X.
+
+unfold_types_in_type(Env, T) ->
+    unfold_types_in_type(Env, T, []).
+
+unfold_types_in_type(Env, {app_t, Ann, Id = {id, _, "map"}, Args = [KeyType0, _]}, Options) ->
+    Args1 = [KeyType, _] = unfold_types_in_type(Env, Args, Options),
+    Ann1 = proplists:get_value(ann, Options, aeso_syntax:get_ann(KeyType0)),
+    [ type_error({map_in_map_key, Ann1, KeyType0}) || has_maps(KeyType) ],
+    {app_t, Ann, Id, Args1};
+unfold_types_in_type(Env, {app_t, Ann, Id, Args}, Options) when ?is_type_id(Id) ->
+    when_warning(warn_unused_typedefs, fun() -> used_typedef(Id, length(Args)) end),
+    UnfoldRecords  = proplists:get_value(unfold_record_types, Options, false),
+    UnfoldVariants = proplists:get_value(unfold_variant_types, Options, false),
+    case aeso_tc_env:lookup_type(Env, Id) of
+        {_, {_, {Formals, {record_t, Fields}}}} when UnfoldRecords, length(Formals) == length(Args) ->
+            {record_t,
+             unfold_types_in_type(Env,
+               subst_tvars(lists:zip(Formals, Args), Fields), Options)};
+        {_, {_, {Formals, {alias_t, Type}}}} when length(Formals) == length(Args) ->
+            unfold_types_in_type(Env, subst_tvars(lists:zip(Formals, Args), Type), Options);
+        {_, {_, {Formals, {variant_t, Constrs}}}} when UnfoldVariants, length(Formals) == length(Args) ->
+            %% TODO: unfolding variant types will not work well if we add recursive types!
+            {variant_t,
+             unfold_types_in_type(Env,
+                subst_tvars(lists:zip(Formals, Args), Constrs), Options)};
+        _ ->
+            %% Not a record type, or ill-formed record type.
+            {app_t, Ann, Id, unfold_types_in_type(Env, Args, Options)}
+    end;
+unfold_types_in_type(Env, Id, Options) when ?is_type_id(Id) ->
+    %% Like the case above, but for types without parameters.
+    when_warning(warn_unused_typedefs, fun() -> used_typedef(Id, 0) end),
+    UnfoldRecords = proplists:get_value(unfold_record_types, Options, false),
+    UnfoldVariants = proplists:get_value(unfold_variant_types, Options, false),
+    case aeso_tc_env:lookup_type(Env, Id) of
+        {_, {_, {[], {record_t, Fields}}}} when UnfoldRecords ->
+            {record_t, unfold_types_in_type(Env, Fields, Options)};
+        {_, {_, {[], {variant_t, Constrs}}}} when UnfoldVariants ->
+            {variant_t, unfold_types_in_type(Env, Constrs, Options)};
+        {_, {_, {[], {alias_t, Type1}}}} ->
+            unfold_types_in_type(Env, Type1, Options);
+        _ ->
+            %% Not a record type, or ill-formed record type
+            Id
+    end;
+unfold_types_in_type(Env, {field_t, Attr, Name, Type}, Options) ->
+    {field_t, Attr, Name, unfold_types_in_type(Env, Type, Options)};
+unfold_types_in_type(Env, {constr_t, Ann, Con, Types}, Options) ->
+    {constr_t, Ann, Con, unfold_types_in_type(Env, Types, Options)};
+unfold_types_in_type(Env, {named_arg_t, Ann, Con, Types, Default}, Options) ->
+    {named_arg_t, Ann, Con, unfold_types_in_type(Env, Types, Options), Default};
+unfold_types_in_type(Env, T, Options) when is_tuple(T) ->
+    list_to_tuple(unfold_types_in_type(Env, tuple_to_list(T), Options));
+unfold_types_in_type(Env, [H|T], Options) ->
+    [unfold_types_in_type(Env, H, Options)|unfold_types_in_type(Env, T, Options)];
+unfold_types_in_type(_Env, X, _Options) ->
+    X.
+
+has_maps({app_t, _, {id, _, "map"}, _}) ->
+    true;
+has_maps(L) when is_list(L) ->
+    lists:any(fun has_maps/1, L);
+has_maps(T) when is_tuple(T) ->
+    has_maps(tuple_to_list(T));
+has_maps(_) -> false.
+
+subst_tvars(Env, Type) ->
+    subst_tvars1([{V, T} || {{tvar, _, V}, T} <- Env], Type).
+
+subst_tvars1(Env, T={tvar, _, Name}) ->
+    proplists:get_value(Name, Env, T);
+subst_tvars1(Env, [H|T]) ->
+    [subst_tvars1(Env, H)|subst_tvars1(Env, T)];
+subst_tvars1(Env, Type) when is_tuple(Type) ->
+    list_to_tuple(subst_tvars1(Env, tuple_to_list(Type)));
+subst_tvars1(_Env, X) ->
+    X.

src/aeso_tc_type_utils.erl

@@ -0,0 +1,91 @@
+-module(aeso_tc_type_utils).
+
+-export([ fresh_uvar/1
+        , dereference/1
+        , dereference_deep/1
+        , instantiate/1
+        , typesig_to_fun_t/1
+        , fun_arity/1
+        , opposite_variance/1
+        , app_t/3
+        , is_first_order/1
+        , is_monomorphic/1
+        ]).
+
+%% TODO: Find a better place for this function
+fresh_uvar(Attrs) ->
+    {uvar, Attrs, make_ref()}.
+
+dereference(T = {uvar, _, R}) ->
+    case aeso_tc_ets_manager:ets_lookup(type_vars, R) of
+        [] ->
+            T;
+        [{R, Type}] ->
+            dereference(Type)
+    end;
+dereference(T) ->
+    T.
+
+dereference_deep(Type) ->
+    case dereference(Type) of
+        Tup when is_tuple(Tup) ->
+            list_to_tuple(dereference_deep(tuple_to_list(Tup)));
+        [H | T] -> [dereference_deep(H) | dereference_deep(T)];
+        T -> T
+    end.
+
+%% Dereferences all uvars and replaces the uninstantiated ones with a
+%% succession of tvars.
+instantiate(E) ->
+    instantiate1(dereference(E)).
+
+instantiate1({uvar, Attr, R}) ->
+    Next = proplists:get_value(next, aeso_tc_ets_manager:ets_lookup(type_vars, next), 0),
+    TVar = {tvar, Attr, "'" ++ integer_to_tvar(Next)},
+    aeso_tc_ets_manager:ets_insert(type_vars, [{next, Next + 1}, {R, TVar}]),
+    TVar;
+instantiate1({fun_t, Ann, Named, Args, Ret}) ->
+    case dereference(Named) of
+        {uvar, _, R} ->
+            %% Uninstantiated named args map to the empty list
+            NoNames = [],
+            aeso_tc_ets_manager:ets_insert(type_vars, [{R, NoNames}]),
+            {fun_t, Ann, NoNames, instantiate(Args), instantiate(Ret)};
+        Named1 ->
+            {fun_t, Ann, instantiate1(Named1), instantiate(Args), instantiate(Ret)}
+    end;
+instantiate1(T) when is_tuple(T) ->
+    list_to_tuple(instantiate1(tuple_to_list(T)));
+instantiate1([A|B]) ->
+    [instantiate(A)|instantiate(B)];
+instantiate1(X) ->
+    X.
+
+integer_to_tvar(X) when X < 26 ->
+    [$a + X];
+integer_to_tvar(X) ->
+    [integer_to_tvar(X div 26)] ++ [$a + (X rem 26)].
+
+fun_arity({fun_t, _, _, Args, _}) -> length(Args);
+fun_arity(_)                      -> none.
+
+is_monomorphic({tvar, _, _})           -> false;
+is_monomorphic(Ts) when is_list(Ts)    -> lists:all(fun is_monomorphic/1, Ts);
+is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
+is_monomorphic(_)                      -> true.
+
+is_first_order({fun_t, _, _, _, _})    -> false;
+is_first_order(Ts) when is_list(Ts)    -> lists:all(fun is_first_order/1, Ts);
+is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
+is_first_order(_)                      -> true.
+
+opposite_variance(invariant) -> invariant;
+opposite_variance(covariant) -> contravariant;
+opposite_variance(contravariant) -> covariant;
+opposite_variance(bivariant) -> bivariant.
+
+app_t(_Ann, Name, [])  -> Name;
+app_t(Ann, Name, Args) -> {app_t, Ann, Name, Args}.
+
+typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) ->
+    {fun_t, Ann, Named, Args, Res}.

src/aeso_tc_typedefs.erl

@@ -0,0 +1,20 @@
+-module(aeso_tc_typedefs).
+
+-export_type([utype/0, named_args_t/0, typesig/0]).
+
+-type uvar() :: {uvar, aeso_syntax:ann(), reference()}.
+
+-type named_args_t() :: uvar() | [{named_arg_t, aeso_syntax:ann(), aeso_syntax:id(), utype(), aeso_syntax:expr()}].
+
+-type utype() :: {fun_t, aeso_syntax:ann(), named_args_t(), [utype()] | var_args, utype()}
+               | {app_t, aeso_syntax:ann(), utype(), [utype()]}
+               | {tuple_t, aeso_syntax:ann(), [utype()]}
+               | aeso_syntax:id()  | aeso_syntax:qid()
+               | aeso_syntax:con() | aeso_syntax:qcon()  %% contracts
+               | aeso_syntax:tvar()
+               | {if_t, aeso_syntax:ann(), aeso_syntax:id(), utype(), utype()}  %% Can branch on named argument (protected)
+               | uvar().
+
+-type type_constraints() :: none | bytes_concat | bytes_split | address_to_contract | bytecode_hash.
+
+-type typesig() :: {type_sig, aeso_syntax:ann(), type_constraints(), [aeso_syntax:named_arg_t()], [aeso_syntax:type()], aeso_syntax:type()}.

src/aeso_tc_unify.erl

@@ -0,0 +1,190 @@
+-module(aeso_tc_unify).
+
+-export([unify/4]).
+
+
+%% -- Moved functions --------------------------------------------------------
+
+unfold_types_in_type(A, B, C) -> aeso_tc_type_unfolding:unfold_types_in_type(A, B, C).
+
+%% -------
+
+type_error(A) -> aeso_tc_errors:type_error(A).
+cannot_unify(A, B, C, D) -> aeso_tc_errors:cannot_unify(A, B, C, D).
+
+%% -------
+
+opposite_variance(A) -> aeso_tc_type_utils:opposite_variance(A).
+
+%% ---------------------------------------------------------------------------
+
+unify(Env, A, B, When) -> unify0(Env, A, B, covariant, When).
+
+unify0(_, {id, _, "_"}, _, _Variance, _When) -> true;
+unify0(_, _, {id, _, "_"}, _Variance, _When) -> true;
+unify0(Env, A, B, Variance, When) ->
+    Options =
+        case When of    %% Improve source location for map_in_map_key errors
+            {check_expr, E, _, _} -> [{ann, aeso_syntax:get_ann(E)}];
+            _                     -> []
+        end,
+    A1 = aeso_tc_type_utils:dereference(unfold_types_in_type(Env, A, Options)),
+    B1 = aeso_tc_type_utils:dereference(unfold_types_in_type(Env, B, Options)),
+    unify1(Env, A1, B1, Variance, When).
+
+unify1(_Env, {uvar, _, R}, {uvar, _, R}, _Variance, _When) ->
+    true;
+unify1(_Env, {uvar, _, _}, {fun_t, _, _, var_args, _}, _Variance, When) ->
+    type_error({unify_varargs, When});
+unify1(Env, {uvar, A, R}, T, _Variance, When) ->
+    case occurs_check(R, T) of
+        true ->
+            case aeso_tc_env:unify_throws(Env) of
+                true ->
+                    cannot_unify({uvar, A, R}, T, none, When);
+                false ->
+                    ok
+            end,
+            false;
+        false ->
+            aeso_tc_ets_manager:ets_insert(type_vars, {R, T}),
+            true
+    end;
+unify1(Env, T, {uvar, A, R}, Variance, When) ->
+    unify1(Env, {uvar, A, R}, T, Variance, When);
+unify1(_Env, {tvar, _, X}, {tvar, _, X}, _Variance, _When) -> true; %% Rigid type variables
+unify1(Env, [A|B], [C|D], [V|Variances], When) ->
+    unify0(Env, A, C, V, When) andalso unify0(Env, B, D, Variances, When);
+unify1(Env, [A|B], [C|D], Variance, When) ->
+    unify0(Env, A, C, Variance, When) andalso unify0(Env, B, D, Variance, When);
+unify1(_Env, X, X, _Variance, _When) ->
+    true;
+unify1(_Env, _A, {id, _, "void"}, Variance, _When)
+  when Variance == covariant orelse Variance == bivariant ->
+    true;
+unify1(_Env, {id, _, "void"}, _B, Variance, _When)
+  when Variance == contravariant orelse Variance == bivariant ->
+    true;
+unify1(_Env, {id, _, Name}, {id, _, Name}, _Variance, _When) ->
+    true;
+unify1(Env, A = {con, _, NameA}, B = {con, _, NameB}, Variance, When) ->
+    case is_subtype(Env, NameA, NameB, Variance) of
+        true -> true;
+        false ->
+            case aeso_tc_env:unify_throws(Env) of
+                true ->
+                    IsSubtype = is_subtype(Env, NameA, NameB, contravariant) orelse
+                                is_subtype(Env, NameA, NameB, covariant),
+                    Cxt = case IsSubtype of
+                              true  -> Variance;
+                              false -> none
+                          end,
+                    cannot_unify(A, B, Cxt, When);
+                false ->
+                    ok
+            end,
+            false
+    end;
+unify1(_Env, {qid, _, Name}, {qid, _, Name}, _Variance, _When) ->
+    true;
+unify1(_Env, {qcon, _, Name}, {qcon, _, Name}, _Variance, _When) ->
+    true;
+unify1(_Env, {bytes_t, _, Len}, {bytes_t, _, Len}, _Variance, _When) ->
+    true;
+unify1(Env, {if_t, _, {id, _, Id}, Then1, Else1}, {if_t, _, {id, _, Id}, Then2, Else2}, Variance, When) ->
+    unify0(Env, Then1, Then2, Variance, When) andalso
+    unify0(Env, Else1, Else2, Variance, When);
+
+unify1(_Env, {fun_t, _, _, _, _}, {fun_t, _, _, var_args, _}, _Variance, When) ->
+    type_error({unify_varargs, When});
+unify1(_Env, {fun_t, _, _, var_args, _}, {fun_t, _, _, _, _}, _Variance, When) ->
+    type_error({unify_varargs, When});
+unify1(Env, {fun_t, _, Named1, Args1, Result1}, {fun_t, _, Named2, Args2, Result2}, Variance, When)
+  when length(Args1) == length(Args2) ->
+    unify0(Env, Named1, Named2, opposite_variance(Variance), When) andalso
+    unify0(Env, Args1, Args2, opposite_variance(Variance), When) andalso
+    unify0(Env, Result1, Result2, Variance, When);
+unify1(Env, {app_t, _, {Tag, _, F}, Args1}, {app_t, _, {Tag, _, F}, Args2}, Variance, When)
+  when length(Args1) == length(Args2), Tag == id orelse Tag == qid ->
+    Variances = case aeso_tc_ets_manager:ets_lookup(type_vars_variance, F) of
+                    [{_, Vs}] ->
+                        case Variance of
+                            contravariant -> lists:map(fun opposite_variance/1, Vs);
+                            invariant     -> invariant;
+                            _             -> Vs
+                        end;
+                    _ -> invariant
+                end,
+    unify1(Env, Args1, Args2, Variances, When);
+unify1(Env, {tuple_t, _, As}, {tuple_t, _, Bs}, Variance, When)
+  when length(As) == length(Bs) ->
+    unify0(Env, As, Bs, Variance, When);
+unify1(Env, {named_arg_t, _, Id1, Type1, _}, {named_arg_t, _, Id2, Type2, _}, Variance, When) ->
+    unify1(Env, Id1, Id2, Variance, {arg_name, Id1, Id2, When}),
+    unify1(Env, Type1, Type2, Variance, When);
+%% The grammar is a bit inconsistent about whether types without
+%% arguments are represented as applications to an empty list of
+%% parameters or not. We therefore allow them to unify.
+unify1(Env, {app_t, _, T, []}, B, Variance, When) ->
+    unify0(Env, T, B, Variance, When);
+unify1(Env, A, {app_t, _, T, []}, Variance, When) ->
+    unify0(Env, A, T, Variance, When);
+unify1(Env, A, B, _Variance, When) ->
+    case aeso_tc_env:unify_throws(Env) of
+        true ->
+            cannot_unify(A, B, none, When);
+        false ->
+            ok
+    end,
+    false.
+
+is_subtype(_Env, NameA, NameB, invariant) ->
+    NameA == NameB;
+is_subtype(Env, NameA, NameB, covariant) ->
+    is_subtype(Env, NameA, NameB);
+is_subtype(Env, NameA, NameB, contravariant) ->
+    is_subtype(Env, NameB, NameA);
+is_subtype(Env, NameA, NameB, bivariant) ->
+    is_subtype(Env, NameA, NameB) orelse is_subtype(Env, NameB, NameA).
+
+is_subtype(Env, Child, Base) ->
+    Parents = maps:get(Child, aeso_tc_env:contract_parents(Env), []),
+    if
+        Child == Base ->
+            true;
+        Parents == [] ->
+            false;
+        true ->
+            case lists:member(Base, Parents) of
+                true -> true;
+                false -> lists:any(fun(Parent) -> is_subtype(Env, Parent, Base) end, Parents)
+            end
+    end.
+
+occurs_check(R, T) ->
+    occurs_check1(R, aeso_tc_type_utils:dereference(T)).
+
+occurs_check1(R, {uvar, _, R1}) -> R == R1;
+occurs_check1(_, {id, _, _}) -> false;
+occurs_check1(_, {con, _, _}) -> false;
+occurs_check1(_, {qid, _, _}) -> false;
+occurs_check1(_, {qcon, _, _}) -> false;
+occurs_check1(_, {tvar, _, _}) -> false;
+occurs_check1(_, {bytes_t, _, _}) -> false;
+occurs_check1(R, {fun_t, _, Named, Args, Res}) ->
+    occurs_check(R, [Res, Named | Args]);
+occurs_check1(R, {app_t, _, T, Ts}) ->
+    occurs_check(R, [T | Ts]);
+occurs_check1(R, {tuple_t, _, Ts}) ->
+    occurs_check(R, Ts);
+occurs_check1(R, {named_arg_t, _, _, T, _}) ->
+    occurs_check(R, T);
+occurs_check1(R, {record_t, Fields}) ->
+    occurs_check(R, Fields);
+occurs_check1(R, {field_t, _, _, T}) ->
+    occurs_check(R, T);
+occurs_check1(R, {if_t, _, _, Then, Else}) ->
+    occurs_check(R, [Then, Else]);
+occurs_check1(R, [H | T]) ->
+    occurs_check(R, H) orelse occurs_check(R, T);
+occurs_check1(_, []) -> false.

src/aeso_tc_warnings.erl

@@ -0,0 +1,231 @@
+-module(aeso_tc_warnings).
+
+-export([ warn_potential_shadowing/3
+        , used_include/1
+        , create_unused_functions/0
+        , destroy_and_report_unused_functions/0
+        , destroy_and_report_warnings_as_type_errors/0
+        , potential_unused_include/2
+        , potential_unused_typedefs/2
+        , potential_unused_constants/2
+        , potential_unused_stateful/2
+        , potential_unused_variables/3
+        , potential_unused_function/4
+        , mk_warning/1
+        , used_variable/3
+        , register_function_call/2
+        , used_constant/2
+        , used_stateful/1
+        , warn_potential_negative_spend/3
+        , warn_potential_division_by_zero/3
+        , potential_unused_return_value/1
+        , used_typedef/2
+        , all_warnings/0
+        ]).
+
+%% -- Moved functions --------------------------------------------------------
+
+name(A) -> aeso_tc_name_manip:name(A).
+qname(A) -> aeso_tc_name_manip:qname(A).
+
+%% -------
+
+pos(A) -> aeso_tc_ann_manip:pos(A).
+
+%% -------
+
+pp_loc(A) -> aeso_tc_pp:pp_loc(A).
+
+%% ---------------------------------------------------------------------------
+
+all_warnings() ->
+    [ warn_unused_includes
+    , warn_unused_stateful
+    , warn_unused_variables
+    , warn_unused_constants
+    , warn_unused_typedefs
+    , warn_unused_return_value
+    , warn_unused_functions
+    , warn_shadowing
+    , warn_division_by_zero
+    , warn_negative_spend ].
+
+%% Warnings (Unused includes)
+
+potential_unused_include(Ann, 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    -> aeso_tc_ets_manager:ets_insert(warnings, {unused_include, File, SrcFile})
+            end
+    end.
+
+used_include(Ann) ->
+    case aeso_syntax:get_ann(file, Ann, no_file) of
+        no_file -> ok;
+        File    -> aeso_tc_ets_manager:ets_match_delete(warnings, {unused_include, File, '_'})
+    end.
+
+%% Warnings (Unused stateful)
+
+potential_unused_stateful(Ann, Fun) ->
+    case aeso_syntax:get_ann(stateful, Ann, false) of
+        false -> ok;
+        true  -> aeso_tc_ets_manager:ets_insert(warnings, {unused_stateful, Ann, Fun})
+    end.
+
+used_stateful(Fun) ->
+    aeso_tc_ets_manager:ets_match_delete(warnings, {unused_stateful, '_', Fun}).
+
+%% Warnings (Unused type defs)
+
+potential_unused_typedefs(Namespace, TypeDefs) ->
+    lists:map(fun({type_def, Ann, Id, Args, _}) ->
+        aeso_tc_ets_manager:ets_insert(warnings, {unused_typedef, Ann, Namespace ++ qname(Id), length(Args)}) end, TypeDefs).
+
+used_typedef(TypeAliasId, Arity) ->
+    aeso_tc_ets_manager:ets_match_delete(warnings, {unused_typedef, '_', qname(TypeAliasId), Arity}).
+
+%% Warnings (Unused variables)
+
+potential_unused_variables(Namespace, Fun, Vars0) ->
+    Vars = [ Var || Var = {id, _, VarName} <- Vars0, VarName /= "_" ],
+    lists:map(fun({id, Ann, VarName}) ->
+        aeso_tc_ets_manager:ets_insert(warnings, {unused_variable, Ann, Namespace, Fun, VarName}) end, Vars).
+
+used_variable(Namespace, Fun, [VarName]) ->
+    aeso_tc_ets_manager:ets_match_delete(warnings, {unused_variable, '_', Namespace, Fun, VarName});
+used_variable(_, _, _) -> ok.
+
+%% Warnings (Unused constants)
+
+potential_unused_constants(Env, Consts) ->
+    case aeso_tc_env:what(Env) of
+        namespace -> [];
+        _ ->
+            [ aeso_tc_ets_manager:ets_insert(warnings, {unused_constant, Ann, aeso_tc_env:namespace(Env), Name}) || {letval, _, {id, Ann, Name}, _} <- Consts ]
+    end.
+
+used_constant(Namespace = [Contract], [Contract, ConstName]) ->
+    aeso_tc_ets_manager: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" ->
+    aeso_tc_ets_manager:ets_insert(warnings, {unused_return_value, Ann});
+potential_unused_return_value(_) -> ok.
+
+%% Warnings (Unused functions)
+
+create_unused_functions() ->
+    aeso_tc_ets_manager:ets_new(function_calls, [bag]),
+    aeso_tc_ets_manager:ets_new(all_functions, [set]).
+
+register_function_call(Caller, Callee) ->
+    aeso_tc_ets_manager:ets_insert(function_calls, {Caller, Callee}).
+
+potential_unused_function(Env, Ann, FunQName, FunId) ->
+    case aeso_tc_env:what(Env) of
+        namespace ->
+            aeso_tc_ets_manager:ets_insert(all_functions, {Ann, FunQName, FunId, not aeso_syntax:get_ann(private, Ann, false)});
+        _ ->
+            aeso_tc_ets_manager:ets_insert(all_functions, {Ann, FunQName, FunId, aeso_syntax:get_ann(entrypoint, Ann, false)})
+    end.
+
+remove_used_funs(All) ->
+    {Used, Unused} = lists:partition(fun({_, _, _, IsUsed}) -> IsUsed end, All),
+    CallsByUsed = lists:flatmap(fun({_, F, _, _}) -> aeso_tc_ets_manager:ets_lookup(function_calls, F) end, Used),
+    CalledFuns = sets:from_list(lists:map(fun({_, Callee}) -> Callee end, CallsByUsed)),
+    MarkUsedFun = fun(Fun, Acc) ->
+                      case lists:keyfind(Fun, 2, Acc) of
+                          false -> Acc;
+                          T     -> lists:keyreplace(Fun, 2, Acc, setelement(4, T, true))
+                      end
+                  end,
+    NewUnused = sets:fold(MarkUsedFun, Unused, CalledFuns),
+    case lists:keyfind(true, 4, NewUnused) of
+        false -> NewUnused;
+        _     -> remove_used_funs(NewUnused)
+    end.
+
+destroy_and_report_unused_functions() ->
+    AllFuns = aeso_tc_ets_manager:ets_tab2list(all_functions),
+    lists:map(fun({Ann, _, FunId, _}) -> aeso_tc_ets_manager:ets_insert(warnings, {unused_function, Ann, name(FunId)}) end,
+              remove_used_funs(AllFuns)),
+    aeso_tc_ets_manager:ets_delete(all_functions),
+    aeso_tc_ets_manager:ets_delete(function_calls).
+
+%% Warnings (Shadowing)
+
+warn_potential_shadowing(_, _, "_") -> ok;
+warn_potential_shadowing(Env, Ann, Name) ->
+    Vars = aeso_tc_env:vars(Env),
+    Consts = aeso_tc_env:scope_consts(aeso_tc_env:get_current_scope(Env)),
+    case proplists:get_value(Name, Vars ++ Consts, false) of
+        false -> ok;
+        {AnnOld, _} -> aeso_tc_ets_manager:ets_insert(warnings, {shadowing, Ann, Name, AnnOld})
+    end.
+
+%% Warnings (Division by zero)
+
+warn_potential_division_by_zero(Ann, Op, Args) ->
+    case {Op, Args} of
+        {{'/', _}, [_, {int, _, 0}]} -> aeso_tc_ets_manager:ets_insert(warnings, {division_by_zero, Ann});
+        _ -> ok
+    end.
+
+%% Warnings (Negative spends)
+
+warn_potential_negative_spend(Ann, Fun, Args) ->
+    case {Fun, Args} of
+        { {typed, _, {qid, _, ["Chain", "spend"]}, _}
+        , [_, {typed, _, {app, _, {'-', _}, [{typed, _, {int, _, X}, _}]}, _}]} when X > 0 ->
+            aeso_tc_ets_manager:ets_insert(warnings, {negative_spend, Ann});
+        _ -> ok
+    end.
+
+destroy_and_report_warnings_as_type_errors() ->
+    Warnings = [ mk_warning(Warn) || Warn <- aeso_tc_ets_manager:ets_tab2list(warnings) ],
+    Errors = lists:map(fun mk_t_err_from_warn/1, Warnings),
+    aeso_errors:throw(Errors).  %% No-op if Warnings == []
+
+mk_t_err_from_warn(Warn) ->
+    aeso_warnings:warn_to_err(type_error, Warn).
+
+mk_warning({unused_include, FileName, SrcFile}) ->
+    Msg = io_lib:format("The file `~s` is included but not used.", [FileName]),
+    aeso_warnings:new(aeso_errors:pos(SrcFile, 0, 0), Msg);
+mk_warning({unused_stateful, Ann, FunName}) ->
+    Msg = io_lib:format("The function `~s` is unnecessarily marked as stateful.", [name(FunName)]),
+    aeso_warnings:new(pos(Ann), Msg);
+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);
+mk_warning({unused_return_value, Ann}) ->
+    Msg = io_lib:format("Unused return value.", []),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({unused_function, Ann, FunName}) ->
+    Msg = io_lib:format("The function `~s` is defined but never used.", [FunName]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({shadowing, Ann, VarName, AnnOld}) ->
+    Msg = io_lib:format("The definition of `~s` shadows an older definition at ~s.", [VarName, pp_loc(AnnOld)]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({division_by_zero, Ann}) ->
+    Msg = io_lib:format("Division by zero.", []),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({negative_spend, Ann}) ->
+    Msg = io_lib:format("Negative spend.", []),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning(Warn) ->
+    Msg = io_lib:format("Unknown warning: ~p", [Warn]),
+    aeso_warnings:new(Msg).

src/aesophia.app.src

@@ -1,6 +1,6 @@
 {application, aesophia,
  [{description, "Compiler for Aeternity Sophia language"},
-  {vsn, "6.1.0"},
+  {vsn, "7.1.0"},
   {registered, []},
   {applications,
    [kernel,

test/aeso_aci_tests.erl

@@ -21,7 +21,7 @@ test_cases(1) ->
 		 "  payable stateful entrypoint a(i : int) = i+1\n">>,
     MapACI = #{contract =>
 		   #{name => <<"C">>,
-		     type_defs => [],
+		     typedefs => [],
          payable => true,
          kind => contract_main,
 		     functions =>
@@ -43,7 +43,7 @@ test_cases(2) ->
     MapACI = #{contract =>
                    #{name => <<"C">>, payable => false,
                      kind => contract_main,
-                     type_defs =>
+                     typedefs =>
                          [#{name => <<"allan">>,
                             typedef => <<"int">>,
                             vars => []}],
@@ -76,7 +76,7 @@ test_cases(3) ->
 		     name => <<"C">>, payable => false, kind => contract_main,
          event => #{variant => [#{<<"SingleEventDefined">> => []}]},
          state => <<"unit">>,
-		     type_defs =>
+		     typedefs =>
              [#{name => <<"bert">>,
                 typedef =>
                     #{variant =>
@@ -127,7 +127,7 @@ check_stub(Stub, Options) ->
         Ast ->
             try
                 %% io:format("AST: ~120p\n", [Ast]),
-                aeso_ast_infer_types:infer(Ast, [])
+                aeso_ast_infer_types:infer(Ast, [no_code])
             catch throw:{type_errors, TE} ->
                 io:format("Type error:\n~s\n", [TE]),
                 error(TE);

test/aeso_calldata_tests.erl

@@ -29,7 +29,7 @@ calldata_aci_test_() ->
      [ {"Testing " ++ ContractName ++ " contract calling " ++ Fun,
         fun() ->
            ContractString       = aeso_test_utils:read_contract(ContractName),
-           {ok, ContractACIBin} = aeso_aci:contract_interface(string, ContractString),
+           {ok, ContractACIBin} = aeso_aci:contract_interface(string, ContractString, [no_code]),
            ContractACI = binary_to_list(ContractACIBin),
            io:format("ACI:\n~s\n", [ContractACIBin]),
            FateExprs = ast_exprs(ContractACI, Fun, Args),
@@ -39,7 +39,7 @@ calldata_aci_test_() ->
         end} || {ContractName, Fun, Args} <- compilable_contracts()].
 
 parse_args(Fun, Args) ->
-    [{contract_main, _, _, [{letfun, _, _, _, _, [{guarded, _, [], {app, _, _, AST}}]}]}] =
+    [{contract_main, _, _, _, [{letfun, _, _, _, _, [{guarded, _, [], {app, _, _, AST}}]}]}] =
         aeso_parser:string("main contract Temp = function foo() = " ++ Fun ++ "(" ++ string:join(Args, ", ") ++ ")"),
     strip_ann(AST).
 

test/aeso_compiler_tests.erl

@@ -45,12 +45,6 @@ simple_compile_test_() ->
            check_errors(ExpectedErrors, Errors)
        end} ||
            {ContractName, ExpectedErrors} <- failing_contracts() ] ++
-    [ {"Testing code generation error messages of " ++ ContractName,
-       fun() ->
-               Errors = compile(ContractName),
-               check_errors([ExpectedError], Errors)
-       end} ||
-           {ContractName, ExpectedError} <- failing_code_gen_contracts()] ++
     [ {"Testing include with explicit files",
        fun() ->
            FileSystem = maps:from_list(
@@ -75,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} ] ++
     [].
@@ -202,6 +197,32 @@ compilable_contracts() ->
      "assign_patterns",
      "patterns_guards",
      "pipe_operator",
+     "polymorphism_contract_implements_interface",
+     "polymorphism_contract_multi_interface",
+     "polymorphism_contract_interface_extends_interface",
+     "polymorphism_contract_interface_extensions",
+     "polymorphism_contract_interface_same_decl_multi_interface",
+     "polymorphism_contract_interface_same_name_same_type",
+     "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",
+     "higher_order_compare",
+     "higher_order_map_keys",
+     "higher_order_state",
+     "polymorphic_compare",
+     "polymorphic_entrypoint",
+     "polymorphic_entrypoint_return",
+     "polymorphic_map_keys",
+     "unapplied_contract_call",
+     "unapplied_named_arg_builtin",
+     "resolve_field_constraint_by_arity",
+     "toplevel_constants",
      "test" % Custom general-purpose test file. Keep it last on the list.
     ].
 
@@ -266,7 +287,11 @@ warnings() ->
       <<?PosW(48, 5)
         "Unused return value.">>,
       <<?PosW(60, 5)
-        "The function `dec` is defined but never used.">>
+        "The function `dec` is defined but never used.">>,
+      <<?PosW(73, 9)
+        "The definition of `const` shadows an older definition at line 70, column 3.">>,
+      <<?PosW(84, 7)
+        "The constant `c` is defined but never used.">>
      ]).
 
 failing_contracts() ->
@@ -283,34 +308,26 @@ failing_contracts() ->
 
     %% Type errors
     , ?TYPE_ERROR(name_clash,
-       [<<?Pos(14, 3)
+       [<<?Pos(4, 3)
+          "Duplicate definitions of `double_def` at\n"
+          "  - line 3, column 3\n"
+          "  - line 4, column 3">>,
+        <<?Pos(7, 3)
           "Duplicate definitions of `abort` at\n"
           "  - (builtin location)\n"
-          "  - line 14, column 3">>,
-        <<?Pos(15, 3)
+          "  - line 7, column 3">>,
+        <<?Pos(8, 3)
           "Duplicate definitions of `require` at\n"
           "  - (builtin location)\n"
-          "  - line 15, column 3">>,
-        <<?Pos(11, 3)
-          "Duplicate definitions of `double_def` at\n"
-          "  - line 10, column 3\n"
-          "  - line 11, column 3">>,
-        <<?Pos(5, 3)
-          "Duplicate definitions of `double_proto` at\n"
-          "  - line 4, column 3\n"
-          "  - line 5, column 3">>,
-        <<?Pos(8, 3)
-          "Duplicate definitions of `proto_and_def` at\n"
-          "  - line 7, column 3\n"
           "  - line 8, column 3">>,
-        <<?Pos(16, 3)
+        <<?Pos(9, 3)
           "Duplicate definitions of `put` at\n"
           "  - (builtin location)\n"
-          "  - line 16, column 3">>,
-        <<?Pos(17, 3)
+          "  - line 9, column 3">>,
+        <<?Pos(10, 3)
           "Duplicate definitions of `state` at\n"
           "  - (builtin location)\n"
-          "  - line 17, column 3">>])
+          "  - line 10, column 3">>])
     , ?TYPE_ERROR(type_errors,
        [<<?Pos(17, 23)
           "Unbound variable `zz`">>,
@@ -564,7 +581,7 @@ failing_contracts() ->
       ])
     , ?TYPE_ERROR(list_comp_bad_shadow,
       [<<?Pos(2, 53)
-         "Cannot unify `int` and `string`\n"
+         "Cannot unify `string` and `int`\n"
          "when checking the type of the pattern `x : int` against the expected type `string`">>
       ])
     , ?TYPE_ERROR(map_as_map_key,
@@ -646,10 +663,6 @@ failing_contracts() ->
          [<<?Pos(5, 28)
             "Invalid call to contract entrypoint `Foo.foo`.\n"
             "It must be called as `c.foo` for some `c : Foo`.">>])
-    , ?TYPE_ERROR(toplevel_let,
-                  [<<?Pos(2, 7)
-                     "Toplevel \"let\" definitions are not supported. "
-                     "Value `this_is_illegal` could be replaced by 0-argument function.">>])
     , ?TYPE_ERROR(empty_typedecl,
                   [<<?Pos(2, 8)
                      "Empty type declarations are not supported. "
@@ -726,10 +739,22 @@ failing_contracts() ->
                      "Conflicting updates for field 'foo'">>])
     , ?TYPE_ERROR(factories_type_errors,
                   [<<?Pos(10,18)
-                    "Chain.clone requires `ref` named argument of contract type.">>,
+                     "Chain.clone requires `ref` named argument of contract type.">>,
                    <<?Pos(11,18)
-                     "Cannot unify `(gas : int, value : int, protected : bool) => if(protected, option(void), void)` and `(gas : int, value : int, protected : bool, int, bool) => 'b`\n"
-                     "when checking contract construction of type\n  (gas : int, value : int, protected : bool) =>\n    if(protected, option(void), void) (at line 11, column 18)\nagainst the expected type\n  (gas : int, value : int, protected : bool, int, bool) => 'b">>,
+                     "Cannot unify `(gas : int, value : int, protected : bool) => if(protected, option(void), void)` and `(gas : int, value : int, protected : bool, int, bool) => if(protected, option(void), void)`\n"
+                     "when checking contract construction of type\n"
+                     "  (gas : int, value : int, protected : bool) =>\n"
+                     "    if(protected, option(void), void) (at line 11, column 18)\n"
+                     "against the expected type\n"
+                     "  (gas : int, value : int, protected : bool, int, bool) =>\n"
+                     "    if(protected, option(void), void)">>,
+                   <<?Pos(11,18)
+                     "Cannot unify `Bakoom` and `Kaboom`\n"
+                     "when checking that contract construction of type\n"
+                     "  Bakoom\n"
+                     "arising from resolution of variadic function `Chain.clone`\n"
+                     "matches the expected type\n"
+                     "  Kaboom">>,
                    <<?Pos(12,37)
                      "Cannot unify `int` and `bool`\n"
                      "when checking named argument `gas : int` against inferred type `bool`">>,
@@ -835,59 +860,412 @@ failing_contracts() ->
                    <<?Pos(48, 5)
                      "Unused return value.">>,
                    <<?Pos(60, 5)
-                     "The function `dec` is defined but never used.">>
+                     "The function `dec` is defined but never used.">>,
+                   <<?Pos(73, 9)
+                     "The definition of `const` shadows an older definition at line 70, column 3.">>,
+                   <<?Pos(84, 7)
+                     "The constant `c` is defined but never used.">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_contract_interface_recursive,
+                  [<<?Pos(1,24)
+                     "Trying to implement or extend an undefined interface `Z`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_contract_interface_same_name_different_type,
+                  [<<?Pos(9,5)
+                     "Duplicate definitions of `f` at\n"
+                     "  - line 8, column 5\n"
+                     "  - line 9, column 5">>])
+    , ?TYPE_ERROR(polymorphism_contract_missing_implementation,
+                  [<<?Pos(4,20)
+                     "Unimplemented entrypoint `f` from the interface `I1` in the contract `I2`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_contract_same_decl_multi_interface,
+                  [<<?Pos(7,10)
+                     "Both interfaces `I` and `J` implemented by the contract `C` have a function called `f`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_contract_undefined_interface,
+                  [<<?Pos(1,14)
+                     "Trying to implement or extend an undefined interface `I`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_contract_same_name_different_type_multi_interface,
+                  [<<?Pos(7,10)
+                     "Both interfaces `I` and `J` implemented by the contract `C` have a function called `f`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_contract_interface_undefined_interface,
+                  [<<?Pos(1,24)
+                     "Trying to implement or extend an undefined interface `H`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_variance_switching,
+                  [<<?Pos(36,49)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the application of\n"
+                     "  `g2 : (Cat) => Cat`\n"
+                     "to arguments\n"
+                     "  `x : Animal`">>,
+                   <<?Pos(39,43)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the expression `g3(x) : Animal` against the expected type `Cat`">>,
+                   <<?Pos(48,55)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the application of\n"
+                     "  `g5 : ((Animal) => Animal) => Cat`\n"
+                     "to arguments\n"
+                     "  `x : (Cat) => Cat`">>,
+                   <<?Pos(52,44)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the expression `f6() : option(Animal)` against the expected type `option(Cat)`">>,
+                   <<?Pos(73,43)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the expression `some_animal : Animal` against the expected type `Cat`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_variance_switching_custom_types,
+                  [<<?Pos(56,39)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_CONTRA(f_c_to_u) : dt_contra(Cat)` against the expected type `dt_contra(Animal)`">>,
+                   <<?Pos(62,35)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the expression `DT_CO(f_u_to_a) : dt_co(Animal)` against the expected type `dt_co(Cat)`">>,
+                   <<?Pos(67,36)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the application of\n  `DT_INV : ((Cat) => Cat) => dt_inv(Cat)`\nto arguments\n  `f_c_to_a : (Cat) => Animal`">>,
+                   <<?Pos(68,36)
+                     "Cannot unify `Cat` and `Animal` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV(f_c_to_c) : dt_inv(Cat)` against the expected type `dt_inv(Animal)`">>,
+                   <<?Pos(69,36)
+                     "Cannot unify `Animal` and `Cat` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV(f_a_to_a) : dt_inv(Animal)` against the expected type `dt_inv(Cat)`">>,
+                   <<?Pos(70,36)
+                     "Cannot unify `Animal` and `Cat` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV(f_a_to_c) : dt_inv(Animal)` against the expected type `dt_inv(Cat)`">>,
+                   <<?Pos(71,36)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the application of\n  `DT_INV : ((Cat) => Cat) => dt_inv(Cat)`\nto arguments\n  `f_c_to_a : (Cat) => Animal`">>,
+                   <<?Pos(80,40)
+                     "Cannot unify `Cat` and `Animal` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV_SEP_A(f_c_to_u) : dt_inv_sep(Cat)` against the expected type `dt_inv_sep(Animal)`">>,
+                   <<?Pos(82,40)
+                     "Cannot unify `Cat` and `Animal` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV_SEP_B(f_u_to_c) : dt_inv_sep(Cat)` against the expected type `dt_inv_sep(Animal)`">>,
+                   <<?Pos(83,40)
+                     "Cannot unify `Animal` and `Cat` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV_SEP_A(f_a_to_u) : dt_inv_sep(Animal)` against the expected type `dt_inv_sep(Cat)`">>,
+                   <<?Pos(85,40)
+                     "Cannot unify `Animal` and `Cat` in a invariant context\n"
+                     "when checking the type of the expression `DT_INV_SEP_B(f_u_to_a) : dt_inv_sep(Animal)` against the expected type `dt_inv_sep(Cat)`">>,
+                   <<?Pos(90,42)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the expression `DT_CO_NEST_A(f_dt_contra_a_to_u) : dt_co_nest_a(Animal)` against the expected type `dt_co_nest_a(Cat)`">>,
+                   <<?Pos(94,46)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_CONTRA_NEST_A(f_dt_co_c_to_u) : dt_contra_nest_a(Cat)` against the expected type `dt_contra_nest_a(Animal)`">>,
+                   <<?Pos(99,46)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_CONTRA_NEST_B(f_u_to_dt_contra_c) : dt_contra_nest_b(Cat)` against the expected type `dt_contra_nest_b(Animal)`">>,
+                   <<?Pos(105,42)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the expression `DT_CO_NEST_B(f_u_to_dt_co_a) : dt_co_nest_b(Animal)` against the expected type `dt_co_nest_b(Cat)`">>,
+                   <<?Pos(110,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `vj3 : dt_co_twice(Cat)` against the expected type `dt_co_twice(Animal)`">>,
+                   <<?Pos(114,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_a_to_c_to_u) : dt_a_contra_b_contra(Animal, Cat)` against the expected type `dt_a_contra_b_contra(Animal, Animal)`">>,
+                   <<?Pos(115,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_c_to_a_to_u) : dt_a_contra_b_contra(Cat, Animal)` against the expected type `dt_a_contra_b_contra(Animal, Animal)`">>,
+                   <<?Pos(116,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_c_to_c_to_u) : dt_a_contra_b_contra(Cat, Cat)` against the expected type `dt_a_contra_b_contra(Animal, Animal)`">>,
+                   <<?Pos(119,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_c_to_a_to_u) : dt_a_contra_b_contra(Cat, Animal)` against the expected type `dt_a_contra_b_contra(Animal, Cat)`">>,
+                   <<?Pos(120,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_c_to_c_to_u) : dt_a_contra_b_contra(Cat, Cat)` against the expected type `dt_a_contra_b_contra(Animal, Cat)`">>,
+                   <<?Pos(122,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_a_to_c_to_u) : dt_a_contra_b_contra(Animal, Cat)` against the expected type `dt_a_contra_b_contra(Cat, Animal)`">>,
+                   <<?Pos(124,59)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the expression `DT_A_CONTRA_B_CONTRA(f_c_to_c_to_u) : dt_a_contra_b_contra(Cat, Cat)` against the expected type `dt_a_contra_b_contra(Cat, Animal)`">>,
+                   <<?Pos(131,13)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the pattern `vl2 : dt_contra_twice(Animal)` against the expected type `dt_contra_twice(Cat)`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_variance_switching_records,
+                  [<<?Pos(27,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `r03 : rec_co(Cat)` against the expected type `Main.rec_co(Animal)`">>,
+                   <<?Pos(33,13)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the pattern `r06 : rec_contra(Animal)` against the expected type `Main.rec_contra(Cat)`">>,
+                   <<?Pos(40,13)
+                     "Cannot unify `Cat` and `Animal` in a invariant context\n"
+                     "when checking the type of the pattern `r10 : rec_inv(Animal)` against the expected type `Main.rec_inv(Cat)`">>,
+                   <<?Pos(41,13)
+                     "Cannot unify `Animal` and `Cat` in a invariant context\n"
+                     "when checking the type of the pattern `r11 : rec_inv(Cat)` against the expected type `Main.rec_inv(Animal)`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_variance_switching_oracles,
+                  [<<?Pos(15,13)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the pattern `o03 : oracle(Animal, Animal)` against the expected type `oracle(Cat, Animal)`">>,
+                   <<?Pos(16,13)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the pattern `o04 : oracle(Animal, Animal)` against the expected type `oracle(Cat, Cat)`">>,
+                   <<?Pos(17,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `o05 : oracle(Animal, Cat)` against the expected type `oracle(Animal, Animal)`">>,
+                   <<?Pos(19,13)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the pattern `o07 : oracle(Animal, Cat)` against the expected type `oracle(Cat, Animal)`">>,
+                   <<?Pos(20,13)
+                     "Cannot unify `Cat` and `Animal` in a contravariant context\n"
+                     "when checking the type of the pattern `o08 : oracle(Animal, Cat)` against the expected type `oracle(Cat, Cat)`">>,
+                   <<?Pos(25,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `o13 : oracle(Cat, Cat)` against the expected type `oracle(Animal, Animal)`">>,
+                   <<?Pos(27,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `o15 : oracle(Cat, Cat)` against the expected type `oracle(Cat, Animal)`">>,
+                   <<?Pos(34,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q05 : oracle_query(Animal, Cat)` against the expected type `oracle_query(Animal, Animal)`">>,
+                   <<?Pos(36,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q07 : oracle_query(Animal, Cat)` against the expected type `oracle_query(Cat, Animal)`">>,
+                   <<?Pos(38,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q09 : oracle_query(Cat, Animal)` against the expected type `oracle_query(Animal, Animal)`">>,
+                   <<?Pos(39,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q10 : oracle_query(Cat, Animal)` against the expected type `oracle_query(Animal, Cat)`">>,
+                   <<?Pos(42,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q13 : oracle_query(Cat, Cat)` against the expected type `oracle_query(Animal, Animal)`">>,
+                   <<?Pos(43,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q14 : oracle_query(Cat, Cat)` against the expected type `oracle_query(Animal, Cat)`">>,
+                   <<?Pos(44,13)
+                     "Cannot unify `Animal` and `Cat` in a covariant context\n"
+                     "when checking the type of the pattern `q15 : oracle_query(Cat, Cat)` against the expected type `oracle_query(Cat, Animal)`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_variance_switching_chain_create_fail,
+                  [<<?Pos(9,22)
+                     "I is not implemented.\n"
+                     "when resolving arguments of variadic function `Chain.create`">>,
+                   <<?Pos(10,13)
+                     "Cannot unify `I` and `C` in a covariant context\n"
+                     "when checking the type of the pattern `c2 : C` against the expected type `I`">>,
+                   <<?Pos(10,22)
+                     "I is not implemented.\n"
+                     "when resolving arguments of variadic function `Chain.create`">>,
+                   <<?Pos(11,22)
+                     "I is not implemented.\n"
+                     "when resolving arguments of variadic function `Chain.create`">>
+                  ])
+    , ?TYPE_ERROR(missing_definition,
+                  [<<?Pos(2,14)
+                     "Missing definition of function `foo`">>
+                  ])
+    , ?TYPE_ERROR(child_with_decls,
+                  [<<?Pos(2,14)
+                     "Missing definition of function `f`">>
+                  ])
+    , ?TYPE_ERROR(parameterised_state,
+                  [<<?Pos(3,8)
+                     "The state type cannot be parameterized">>
+                  ])
+    , ?TYPE_ERROR(parameterised_event,
+                  [<<?Pos(3,12)
+                     "The event type cannot be parameterized">>
+                  ])
+    , ?TYPE_ERROR(missing_init_fun_alias_to_type,
+                  [<<?Pos(1,10)
+                     "Missing `init` function for the contract `AliasToType`.\n"
+                     "The `init` function can only be omitted if the state type is `unit`">>
+                  ])
+    , ?TYPE_ERROR(missing_init_fun_alias_to_alias_to_type,
+                  [<<?Pos(1,10)
+                     "Missing `init` function for the contract `AliasToAliasToType`.\n"
+                     "The `init` function can only be omitted if the state type is `unit`">>
+                  ])
+    , ?TYPE_ERROR(higher_order_entrypoint,
+                  [<<?Pos(2,20)
+                     "The argument\n"
+                     "  `f : (int) => int`\n"
+                     "of entrypoint `apply` has a higher-order (contains function types) type">>
+                  ])
+    , ?TYPE_ERROR(higher_order_entrypoint_return,
+                  [<<?Pos(2,3)
+                     "The return type\n"
+                     "  `(int) => int`\n"
+                     "of entrypoint `add` is higher-order (contains function types)">>
+                  ])
+    , ?TYPE_ERROR(polymorphic_aens_resolve,
+                  [<<?Pos(4,5)
+                     "Invalid return type of `AENS.resolve`:\n"
+                     "  `'a`\n"
+                     "It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
+                  ])
+    , ?TYPE_ERROR(bad_aens_resolve,
+                  [<<?Pos(6,5)
+                     "Invalid return type of `AENS.resolve`:\n"
+                     "  `list(int)`\n"
+                     "It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
+                  ])
+    , ?TYPE_ERROR(bad_aens_resolve_using,
+                  [<<?Pos(7,5)
+                     "Invalid return type of `AENS.resolve`:\n"
+                     "  `list(int)`\n"
+                     "It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
+                  ])
+    , ?TYPE_ERROR(polymorphic_query_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle('a, 'b)`\n"
+                     "The query type must not be polymorphic (contain type variables)">>,
+                   <<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle('a, 'b)`\n"
+                     "The response type must not be polymorphic (contain type variables)">>
+                  ])
+    , ?TYPE_ERROR(polymorphic_response_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle(string, 'r)`\n"
+                     "The response type must not be polymorphic (contain type variables)">>
+                  ])
+    , ?TYPE_ERROR(higher_order_query_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle((int) => int, string)`\n"
+                     "The query type must not be higher-order (contain function types)">>
+                  ])
+    , ?TYPE_ERROR(higher_order_response_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle(string, (int) => int)`\n"
+                     "The response type must not be higher-order (contain function types)">>
+                  ])
+    , ?TYPE_ERROR(var_args_unify_let,
+                  [<<?Pos(3,9)
+                     "Cannot infer types for variable argument list.\n"
+                     "when checking the type of the pattern `x : 'a` against the expected type `(gas : int, value : int, protected : bool, ref : 'b, var_args) => 'b`">>
+                  ])
+    , ?TYPE_ERROR(var_args_unify_fun_call,
+                  [<<?Pos(6,5)
+                     "Cannot infer types for variable argument list.\n"
+                     "when checking the application of\n"
+                     "  `g : (() => 'b) => 'b`\n"
+                     "to arguments\n"
+                     "  `Chain.create : (value : int, var_args) => 'c`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_add_stateful_entrypoint,
+                  [<<?Pos(5,25)
+                     "`f` cannot be stateful because the entrypoint `f` in the interface `I` is not stateful">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_change_entrypoint_to_function,
+                  [<<?Pos(6,14)
+                     "`f` must be declared as an entrypoint instead of a function in order to implement the entrypoint `f` from the interface `I`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_non_payable_contract_implement_payable,
+                  [<<?Pos(4,10)
+                     "Non-payable contract `C` cannot implement payable interface `I`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_non_payable_interface_implement_payable,
+                  [<<?Pos(4,20)
+                     "Non-payable interface `H` cannot implement payable interface `I`">>
+                  ])
+    , ?TYPE_ERROR(polymorphism_remove_payable_entrypoint,
+                  [<<?Pos(5,16)
+                     "`f` must be payable because the entrypoint `f` in the interface `I` is payable">>
+                  ])
+    , ?TYPE_ERROR(calling_child_contract_entrypoint,
+                  [<<?Pos(5,20)
+                     "Invalid call to contract entrypoint `F.g`.\n"
+                     "It must be called as `c.g` for some `c : F`.">>])
+    , ?TYPE_ERROR(using_contract_as_namespace,
+                  [<<?Pos(5,3)
+                     "Cannot use undefined namespace F">>])
+    , ?TYPE_ERROR(hole_expression,
+                  [<<?Pos(5,13)
+                     "Found a hole of type `bool`">>,
+                   <<?Pos(6,17)
+                     "Found a hole of type `string`">>,
+                   <<?Pos(9,37)
+                     "Found a hole of type `(int) => int`">>,
+                   <<?Pos(13,20)
+                     "Found a hole of type `'a`">>
+                  ])
+    , ?TYPE_ERROR(toplevel_constants_contract_as_namespace,
+                  [<<?Pos(5,13)
+                     "Invalid use of the contract constant `G.const`.\n"
+                     "Toplevel contract constants can only be used in the contracts where they are defined.">>,
+                   <<?Pos(10,11)
+                     "Record type `G` does not have field `const`">>,
+                   <<?Pos(10,11)
+                     "Unbound field const">>,
+                   <<?Pos(11,11)
+                     "Record type `G` does not have field `const`">>,
+                   <<?Pos(11,11)
+                     "Unbound field const">>
+                  ])
+    , ?TYPE_ERROR(toplevel_constants_cycles,
+                  [<<?Pos(2,21)
+                     "Unbound variable `selfcycle`">>,
+                   <<?Pos(4,5)
+                     "Mutual recursion detected between the constants\n"
+                     "  - `cycle1` at line 4, column 5\n"
+                     "  - `cycle2` at line 5, column 5\n"
+                     "  - `cycle3` at line 6, column 5">>
+                  ])
+    , ?TYPE_ERROR(toplevel_constants_in_interface,
+                  [<<?Pos(2,10)
+                     "The name of the compile-time constant cannot have pattern matching">>,
+                   <<?Pos(3,5)
+                     "Cannot define toplevel constants inside a contract interface">>,
+                   <<?Pos(4,5)
+                     "Cannot define toplevel constants inside a contract interface">>
+                  ])
+    , ?TYPE_ERROR(toplevel_constants_invalid_expr,
+                  [<<?Pos(10,9)
+                     "Invalid expression in the definition of the constant `c01`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(11,9)
+                     "Invalid expression in the definition of the constant `c02`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(12,9)
+                     "Invalid expression in the definition of the constant `c03`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(13,9)
+                     "Invalid expression in the definition of the constant `c04`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(14,9)
+                     "Invalid expression in the definition of the constant `c05`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(17,9)
+                     "Invalid expression in the definition of the constant `c07`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(18,9)
+                     "Invalid expression in the definition of the constant `c08`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(19,9)
+                     "Invalid expression in the definition of the constant `c09`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(20,9)
+                     "Invalid expression in the definition of the constant `c10`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
+                   <<?Pos(21,9)
+                     "Invalid expression in the definition of the constant `c11`\n"
+                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>
+                  ])
+    , ?TYPE_ERROR(toplevel_constants_invalid_id,
+                  [<<?Pos(2,9)
+                     "The name of the compile-time constant cannot have pattern matching">>,
+                   <<?Pos(3,9)
+                     "The name of the compile-time constant cannot have pattern matching">>
                   ])
-    ].
-
--define(Path(File), "code_errors/" ??File).
--define(Msg(File, Line, Col, Err), <<?Pos("Code generation", ?Path(File), Line, Col) Err>>).
-
--define(FATE_ERR(File, Line, Col, Err), {?Path(File), ?Msg(File, Line, Col, Err)}).
-
-failing_code_gen_contracts() ->
-    [ ?FATE_ERR(missing_definition, 2, 14,
-            "Missing definition of function 'foo'.")
-    , ?FATE_ERR(higher_order_entrypoint, 2, 20,
-            "The argument\n"
-            "  f : (int) => int\n"
-            "of entrypoint 'apply' has a higher-order (contains function types) type.")
-    , ?FATE_ERR(higher_order_entrypoint_return, 2, 3,
-            "The return type\n"
-            "  (int) => int\n"
-            "of entrypoint 'add' is higher-order (contains function types).")
-    , ?FATE_ERR(missing_init_function, 1, 10,
-            "Missing init function for the contract 'MissingInitFunction'.\n"
-            "The 'init' function can only be omitted if the state type is 'unit'.")
-    , ?FATE_ERR(parameterised_state, 3, 8,
-            "The state type cannot be parameterized.")
-    , ?FATE_ERR(parameterised_event, 3, 12,
-            "The event type cannot be parameterized.")
-    , ?FATE_ERR(polymorphic_aens_resolve, 4, 5,
-            "Invalid return type of AENS.resolve:\n"
-            "  'a\n"
-            "It must be a string or a pubkey type (address, oracle, etc).")
-    , ?FATE_ERR(bad_aens_resolve, 6, 5,
-            "Invalid return type of AENS.resolve:\n"
-            "  list(int)\n"
-            "It must be a string or a pubkey type (address, oracle, etc).")
-    , ?FATE_ERR(polymorphic_query_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle('a, 'b)\n"
-            "The query type must not be polymorphic (contain type variables).")
-    , ?FATE_ERR(polymorphic_response_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle(string, 'r)\n"
-            "The response type must not be polymorphic (contain type variables).")
-    , ?FATE_ERR(higher_order_query_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle((int) => int, string)\n"
-            "The query type must not be higher-order (contain function types).")
-    , ?FATE_ERR(higher_order_response_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle(string, (int) => int)\n"
-            "The response type must not be higher-order (contain function types).")
-    , ?FATE_ERR(child_with_decls, 2, 14,
-            "Missing definition of function 'f'.")
     ].
 
 validation_test_() ->

test/aeso_parser_tests.erl

@@ -15,7 +15,7 @@ simple_contracts_test_() ->
             Text = "main contract Identity =\n"
                    "  function id(x) = x\n",
             ?assertMatch(
-                [{contract_main, _, {con, _, "Identity"},
+                [{contract_main, _, {con, _, "Identity"}, _,
                     [{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"},
                         [{guarded, _, [], {id, _, "x"}}]}]}], parse_string(Text)),
             ok

test/contracts/aens.aes

@@ -1,5 +1,7 @@
+contract C = entrypoint init() = ()
+
 // AENS tests
-contract AENSTest =
+main contract AENSTest =
 
   // Name resolution
 
@@ -9,10 +11,19 @@ contract AENSTest =
   stateful entrypoint resolve_string(name : string, key : string) : option(string) =
     AENS.resolve(name, key)
 
+  stateful entrypoint resolve_contract(name : string, key : string) : option(C) =
+    AENS.resolve(name, key)
+
+  stateful entrypoint resolve_oracle(name : string, key : string) : option(oracle(int, int)) =
+    AENS.resolve(name, key)
+
+  stateful entrypoint resolve_oracle_query(name : string, key : string) : option(oracle_query(int, int)) =
+    AENS.resolve(name, key)
+
   // Transactions
 
   stateful entrypoint preclaim(addr  : address,     // Claim on behalf of this account (can be Contract.address)
-                             chash : hash) : unit = // Commitment hash
+                               chash : hash) : unit = // Commitment hash
     AENS.preclaim(addr, chash)
 
   stateful entrypoint signedPreclaim(addr  : address, // Claim on behalf of this account (can be Contract.address)

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,
@@ -80,3 +83,4 @@ contract AllSyntax =
      let sh : shakespeare(shakespeare(int)) =
        {wolfgang = state}
      sh{wolfgang.wolfgang = sh.wolfgang} // comment
+     exit("hope you had fun reading this")

test/contracts/bad_aens_resolve_using.aes

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

test/contracts/calling_child_contract_entrypoint.aes

@@ -0,0 +1,5 @@
+contract F =
+  entrypoint g() = 1
+
+main contract C =
+  entrypoint f() = F.g()

test/contracts/code_errors/missing_init_function.aes

@@ -1,3 +0,0 @@
-contract MissingInitFunction =
-  type state = int * int
-

test/contracts/complex_types.aes

@@ -1,16 +1,7 @@
 
-contract interface Remote =
-  entrypoint up_to       : (int)               => list(int)
-  entrypoint sum         : (list(int))         => int
-  entrypoint some_string : ()                  => string
-  entrypoint pair        : (int, string)       => int * string
-  entrypoint squares     : (int)               => list(int * int)
-  entrypoint filter_some : (list(option(int))) => list(int)
-  entrypoint all_some    : (list(option(int))) => option(list(int))
-
 contract ComplexTypes =
 
-  record state = { worker : Remote }
+  record state = { worker : ComplexTypes }
 
   entrypoint init(worker) = {worker = worker}
 

test/contracts/environment.aes

@@ -1,14 +1,9 @@
 
 // Testing primitives for accessing the block chain environment
-contract interface Interface =
-  entrypoint contract_address : () => address
-  entrypoint call_origin      : () => address
-  entrypoint call_caller      : () => address
-  entrypoint call_value       : () => int
 
 contract Environment =
 
-  record state = {remote : Interface}
+  record state = {remote : Environment}
 
   entrypoint init(remote) = {remote = remote}
 

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() = ???

test/contracts/missing_init_fun_alias_to_alias_to_type.aes

@@ -0,0 +1,3 @@
+contract AliasToAliasToType =
+  type alias = int * int
+  type state = alias

test/contracts/missing_init_fun_alias_to_type.aes

@@ -0,0 +1,2 @@
+contract AliasToType =
+  type state = int * int

test/contracts/missing_init_fun_state_unit.aes

@@ -0,0 +1,9 @@
+contract AliasToAliasToUnit =
+  type alias = unit
+  type state = alias
+
+contract AliasToUnit =
+  type state = unit
+
+main contract ImplicitState =
+    type sometype = int

test/contracts/name_clash.aes

@@ -1,12 +1,5 @@
-
 contract NameClash =
 
-  entrypoint double_proto : () => int
-  entrypoint double_proto : () => int
-
-  entrypoint proto_and_def : int => int
-  entrypoint proto_and_def(n) = n + 1
-
   entrypoint double_def(x) = x
   entrypoint double_def(y) = 0
 
@@ -14,4 +7,4 @@ contract NameClash =
   entrypoint abort() : int = 0
   entrypoint require(b, err) = if(b) abort(err)
   entrypoint put(x) = x
-  entrypoint state(x, y) = x + y
+  entrypoint state(x, y) = x + y

test/contracts/polymorphism_add_stateful_entrypoint.aes

@@ -0,0 +1,5 @@
+contract interface I =
+    entrypoint f : () => int
+
+contract C : I =
+    stateful entrypoint f() = 1

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

test/contracts/polymorphism_contract_implements_interface.aes

@@ -0,0 +1,5 @@
+contract interface Strokable =
+  entrypoint stroke : () => string
+
+contract Cat : Strokable =
+  entrypoint stroke() = "Cat stroke"

test/contracts/polymorphism_contract_interface_extends_interface.aes

@@ -0,0 +1,10 @@
+contract interface II =
+    entrypoint f : () => unit
+
+contract interface I : II =
+    entrypoint f : () => unit
+    entrypoint g : () => unit
+
+contract C : I =
+    entrypoint f() = ()
+    entrypoint g() = ()

test/contracts/polymorphism_contract_interface_extensions.aes

@@ -0,0 +1,9 @@
+contract interface I0 =
+  entrypoint f : () => int
+
+contract interface I1 : I0 =
+  entrypoint f : () => int
+  entrypoint something_else : () => int
+
+main contract C =
+  entrypoint f(x : I1) = x.f() // Here we should know that x has f

test/contracts/polymorphism_contract_interface_recursive.aes

@@ -0,0 +1,13 @@
+contract interface X : Z =
+    entrypoint x : () => int
+
+contract interface Y : X =
+    entrypoint y : () => int
+
+contract interface Z : Y =
+    entrypoint z : () => int
+
+contract C : Z =
+    entrypoint x() = 1
+    entrypoint y() = 1
+    entrypoint z() = 1

test/contracts/polymorphism_contract_interface_same_decl_multi_interface.aes

@@ -0,0 +1,8 @@
+contract interface I =
+    entrypoint f : () => int
+
+contract interface II : I =
+    entrypoint f : () => int
+
+contract C : II =
+    entrypoint f() = 1

test/contracts/polymorphism_contract_interface_same_name_different_type.aes

@@ -0,0 +1,9 @@
+contract interface I1 =
+    entrypoint f : () => int
+
+contract interface I2 : I1 =
+    entrypoint f : () => char
+
+contract C : I2 =
+    entrypoint f() = 1
+    entrypoint f() = 'c'

test/contracts/polymorphism_contract_interface_same_name_same_type.aes

@@ -0,0 +1,8 @@
+contract interface I1 =
+    entrypoint f : () => int
+
+contract interface I2 : I1 =
+    entrypoint f : () => int
+
+contract C : I2 =
+    entrypoint f() = 1

test/contracts/polymorphism_contract_interface_undefined_interface.aes

@@ -0,0 +1,5 @@
+contract interface I : H =
+    entrypoint f : () => unit
+
+contract C =
+    entrypoint g() = ()

test/contracts/polymorphism_contract_missing_implementation.aes

@@ -0,0 +1,8 @@
+contract interface I1 =
+    entrypoint f : () => int
+
+contract interface I2 : I1 =
+    entrypoint g : () => int
+
+contract C : I2 =
+    entrypoint g() = 1

test/contracts/polymorphism_contract_multi_interface.aes

@@ -0,0 +1,9 @@
+contract interface I =
+    entrypoint f : () => int
+
+contract interface J =
+    entrypoint g : () => char
+
+contract C : I, J =
+    entrypoint f() = 1
+    entrypoint g() = 'c'

test/contracts/polymorphism_contract_same_decl_multi_interface.aes

@@ -0,0 +1,8 @@
+contract interface I =
+    entrypoint f : () => int
+
+contract interface J =
+    entrypoint f : () => int
+
+contract C : I, J =
+    entrypoint f() = 1

test/contracts/polymorphism_contract_same_name_different_type_multi_interface.aes

@@ -0,0 +1,9 @@
+contract interface I =
+    entrypoint f : () => int
+
+contract interface J =
+    entrypoint f : () => char
+
+contract C : I, J =
+    entrypoint f() = 1
+    entrypoint f() = 'c'

test/contracts/polymorphism_contract_undefined_interface.aes

@@ -0,0 +1,2 @@
+contract C : I =
+    entrypoint f() = ()

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

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

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

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

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

test/contracts/polymorphism_remove_payable_entrypoint.aes

@@ -0,0 +1,5 @@
+contract interface I =
+    payable entrypoint f : () => int
+
+contract C : I =
+    entrypoint f() = 1