Compare commits

...

49 Commits

Author SHA1 Message Date
Gaith Hallak 9a95df2108 Remove unexported functions 2023-05-06 20:08:16 +03:00
Gaith Hallak adb37fa510 Revert "Remove unused functions"
This reverts commit f835862a48.
2023-05-06 20:04:18 +03:00
Gaith Hallak f835862a48 Remove unused functions 2023-05-06 16:34:22 +03:00
Gaith Hallak 8475b024df Break the dependecy between constraints and env 2023-05-06 14:07:14 +03:00
Gaith Hallak b98af0fab6 Move fresh_uvar to type utils 2023-05-06 13:48:52 +03:00
Gaith Hallak 6193d144a2 Remove unknown wanring error from type errors 2023-05-06 13:28:57 +03:00
Gaith Hallak add858a1ad Move bind_consts to aeso_ast_infer_types
The reason for this is that it depends on infer_const
2023-05-06 13:22:59 +03:00
Gaith Hallak fa94b96997 Move freshening functions to aeso_tc_env 2023-05-06 12:14:24 +03:00
Gaith Hallak ac428d1e36 Move error reporting to aeso_tc_env 2023-04-30 21:15:14 +03:00
Gaith Hallak de4c8f5412 Remove the dependency of type_utils on errors 2023-04-30 13:48:23 +03:00
Gaith Hallak 0dc647f139 Move typedefs to a separate module 2023-04-30 11:12:26 +03:00
Gaith Hallak fceb124f89 Remove freshening from the type checker 2023-04-30 11:01:51 +03:00
Gaith Hallak dab0e4b758 Move opposite_variance to type utils 2023-04-30 10:00:46 +03:00
Gaith Hallak fbf12cf8b4 Split unfolding from the type checker 2023-04-30 09:20:08 +03:00
Gaith Hallak 2cdd3ed576 Split unification from the type checker 2023-04-29 14:26:32 +03:00
Gaith Hallak 5f277bed08 Remove aeso_ast module 2023-04-29 13:50:11 +03:00
Gaith Hallak 565863681c Split constraints from type checker 2023-04-29 11:25:55 +03:00
Gaith Hallak 9fe2696432 Split env from the type checker 2023-04-29 07:26:04 +03:00
Gaith Hallak 4c90b00fd0 Implement env getters and setters 2023-04-26 12:55:23 +03:00
Gaith Hallak 9f8f3c2ac8 Move blocks processing to desugar module 2023-04-24 17:45:32 +03:00
Gaith Hallak 4a8870fb1d Rename ets_manager and type_utils 2023-04-24 16:30:50 +03:00
Gaith Hallak a91470fe3c Split desugaring from the type checker 2023-04-24 16:23:18 +03:00
Gaith Hallak ab69b6c2a7 Split warnings from the type checker 2023-04-22 12:11:28 +03:00
Gaith Hallak 296b2a4bb0 Remove duplicated record definition 2023-04-21 21:17:10 +03:00
Gaith Hallak 1f0726fad7 Split type errors from type checker 2023-04-21 21:06:46 +03:00
Gaith Hallak 433d180c17 Split pretty printing from type checker 2023-04-21 20:28:56 +03:00
Gaith Hallak 30a179bfcc Move smaller functions outside of aeso_ast_infer_types 2023-04-21 20:07:53 +03:00
Gaith Hallak 0e4c24958c Remove the access of scopes 2023-04-21 19:51:40 +03:00
Gaith Hallak 0baedfeede Move typesig_to_fun_t to type utils 2023-04-20 20:23:58 +03:00
Gaith Hallak 36058df924 Split utils and ets management 2023-04-20 20:05:23 +03:00
Gaith Hallak 7b6eba5319 Introduce contract-level compile-time constants (#432)
* Allow compile-time constants as toplevel declarations

* Remove the test that fails on toplevel consts

* Warn when shadowing a constant

* Allow records to be used as compile time constants

* Allow data constructors in compile-time constants

* Disable some warnings for toplevel constants

Since variables and functions cannot be used in the definition of
a compile time constants, the following warnings are not going to be
reported:

* Used/Unused variable
* Used/Unused function

* Do not reverse constants declarations

* Add tests for all valid expressions

* Add test for accessing const from namespace

* Revert "Do not reverse constants declarations"

This reverts commit c4647fadacd134866e4be9c2ab4b0d54870a35fd.

* Add test for assigining constant to a constant

* Show empty map or record error when assigning to const

* Report all invalid constant expressions before fail

* Allow accessing records fields in toplevel consts

* Undo a mistake

* Add test for warning on const shadowing

* Show error message when using pattern matching for consts

* Remove unused error

* Ban toplevel constants in contract interfaces

* Varibles rename

* Change the error message for invalid_const_id

* Make constants public in namespaces and private in contracts

* Add a warning about unused constants in contracts

* Use ban_when_const for function applications

* Test for qualified access of constants in functions

* Add failing tests

* Add test for the unused const warning

* Update CHANGELOG

* Update all_syntax test file

* Treat expr and type inside bound as bound

* Allow typed ids to be used for constants

* List valid exprs in the error message for invalid exprs

* Fix tests

* Update the docs about constants

* Update syntax docs

* Check validity of const exprs in a separate functions

* Call both resolve_const and resolve_fun from resolve_var
2023-04-12 14:20:41 +03:00
Gaith Hallak 99bb3fe1fb Mark only included files as potentially unused (#442)
* Mark only included files as potentially unused

* Update CHANGELOG

* Add test
2023-03-21 13:55:18 +03:00
Hans Svensson 311bf49505 Prepare v7.1.0 release (#438) 2023-02-24 09:40:06 +01:00
Denis Davidyuk 0e3bcba07d Fix markup in sophia_features.md (#437) 2023-02-15 13:27:29 +03:00
Marco Walz 699d1f7ab8 fix: use latest pygments version to generate docs (#435) 2023-02-02 08:32:54 +01:00
Marco Walz 1a40a93157 chore(deps): mkdocs version update (#434) 2023-02-02 10:16:27 +03:00
Gaith Hallak c078119bc4 Add hole expression (#433)
* Add hole expressions

* Fix the issue of unreported holes

* Add tests

* New line in the end of the test file

* Update CHANGELOG

* Add hole expression to the docs

* Do not treat hole as a special type

* Update docs

* Update docs/sophia_features.md

Co-authored-by: Radosław Rowicki <35342116+radrow@users.noreply.github.com>

Co-authored-by: Radosław Rowicki <35342116+radrow@users.noreply.github.com>
2023-01-12 16:23:36 +03:00
Gaith Hallak 31fd8fe24f Hide warning when calling with non-0 value arg (#431)
* Hide warning when calling with non-0 value arg

* Update the tests

* Update CHANGELOG
2022-12-12 11:44:24 +03:00
Nikita Fuchs 9ad8e26e88 Add clarification for Chain.timestamp in the stdlib docs (#429) 2022-12-07 17:34:55 +03:00
Gaith Hallak 5adeb6c93e Ban using contracts as namespaces (#428)
* Ban calling contracts functions as functions namespaces

* Ban using contracts as namespaces

* Add tests

* Update CHANGELOG

* Separate guards with a semicolon
2022-11-23 12:03:24 +03:00
Gaith Hallak 256df25af4 Check contracts and entrypoints modifiers when implementing interfaces (#427)
* Check contracts and entrypoints modifiers when implementing interfaces

* Fix existing tests

* Add passing tests

* Add failing tests

* Update docs

* Update CHANGELOG
2022-11-17 11:40:57 +03:00
Gaith Hallak 83abfae32b Ban the unification of uvars and var_args functions (#423)
* Ban the unification of uvar and var_args function

* Update CHANGELOG

* Fix the tests

* Undo indent

* Change the error message for unify_varargs
2022-11-01 18:10:57 +02:00
Denis Davidyuk 4ca90feea0 Rename type_defs to typedefs in ACI to increase compatibility (#421) 2022-11-01 08:55:00 +02:00
Gaith Hallak 09638daa90 Return mapping from variables to registers in fate compilation (#411)
* Return mapping from variables to registers

* Fix dialyzer issues

* Record real names

* Report saved fresh names as part of fcode env

* Undo whitespace changes

* Fix dialyzer warnings

* Formatting fix

* Use function names as strings

* Manually handle making function names

* Update CHANGELOG

* Make variables registers optional

* Update docs about the new flag

* Remove empty saved_fresh_names map from fcode env
2022-10-25 09:42:02 +03:00
Gaith Hallak d59023a9f4 Allow calling a different instance of the current contract (#379)
Add functions as fields before inferring

Unbound untyped fields before binding typed ones

Fix failing tests

Make complex_types contract non-compatible with aevm

Reduce code duplication

Undo changes to test.aes

Remove special handling of __constructor__ field

Resolve field constraint by arity of contract function

Update CHANGELOG

Update CHANGELOG.md

Co-authored-by: Radosław Rowicki <35342116+radrow@users.noreply.github.com>

Split bind_field function

Add a comment about rebinding
2022-10-23 15:01:28 +03:00
Radosław Rowicki 34b52739fd Include all functions in the symbols map (#418)
* Include all functions in the symbols map

* .

* remove improper wording

* Use update_symbols exported from aebytecode

* Extract adding child symbols into a separate fun

* Make child contracts symbols optional

* Document include_child_contract_symbols option

Co-authored-by: Gaith Hallak <gaithhallak@gmail.com>
2022-10-07 15:57:37 +03:00
Gaith Hallak 1c83287d45 Add separate flags for each scode optimization (#410)
* Add separate flags for each scode optimization

* Add a list of available optimizations to docs

* Update CONTRIBUTING.md

* Update docs/aeso_compiler.md

Co-authored-by: Radosław Rowicki <35342116+radrow@users.noreply.github.com>

* Prefix rules functions with optimize_ instead of r_

Co-authored-by: Radosław Rowicki <35342116+radrow@users.noreply.github.com>
2022-10-07 12:09:53 +03:00
Gaith Hallak da92ddbd5d Polymorphism fixes (#415)
* Assume that void is a supertype of all types

* Add test for void supertype

* Unify functions with decls from implemented interfaces

* Rename delete_if_implementation

* Match only with function name and without typesig
2022-10-04 12:40:50 +03:00
Gaith Hallak c1c169273c Add options to enable/disable certain optimizations (#409)
* Add flags to enable/disable specific optimizations

* Fix typos

* Enable/disable scode optimization

* Update CHANGELOG.md

* Remove optimize_all option
2022-08-30 10:14:46 +03:00
66 changed files with 4601 additions and 3086 deletions
+3 -3
View File
@@ -1,5 +1,5 @@
mkdocs==1.2.4
mkdocs==1.4.2
mkdocs-simple-hooks==0.1.5
mkdocs-material==7.3.6
mkdocs-material==9.0.9
mike==1.1.2
pygments==2.12.0
pygments==2.14.0
+29 -1
View File
@@ -6,9 +6,36 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
## [Unreleased]
### Added
- 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
@@ -361,7 +388,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Simplify calldata creation - instead of passing a compiled contract, simply
pass a (stubbed) contract string.
[Unreleased]: https://github.com/aeternity/aesophia/compare/v7.0.1...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
+2
View File
@@ -10,6 +10,8 @@ The following points should be considered before creating a new PR to the Sophia
- 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
+2 -2
View File
@@ -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 => []}]}}]}
+30
View File
@@ -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
+54 -4
View File
@@ -191,6 +191,17 @@ contract interface X : Z =
entrypoint z() = 1
```
#### Adding or removing modifiers
When a `contract` or a `contract interface` implements another `contract interface`, the `payable` and `stateful` modifiers can be kept or changed, both in the contract and in the entrypoints, according to the following rules:
1. A `payable` contract or interface can implement a `payable` interface or a non-`payable` interface.
2. A non-`payable` contract or interface can only implement a non-`payable` interface, and cannot implement a `payable` interface.
3. A `payable` entrypoint can implement a `payable` entrypoint or a non-`payable` entrypoint.
4. A non-`payable` entrypoint can only implement a non-`payable` entrypoint, and cannot implement a `payable` entrypoint.
5. A non-`stateful` entrypoint can implement a `stateful` entrypoint or a non-`stateful` entrypoint.
6. A `stateful` entrypoint can only implement a `stateful` entrypoint, and cannot implement a non-`stateful` entrypoint.
#### Subtyping and variance
Subtyping in Sophia follows common rules that take type variance into account. As described by [Wikipedia](https://en.wikipedia.org/wiki/Covariance_and_contravariance_(computer_science)),
@@ -245,10 +256,10 @@ datatype bi('a) = Bi // bi is bivariant on 'a
The following facts apply here:
- `co('a)` is a subtype of `co('b) when `'a` is a subtype of `'b`
- `ct('a)` is a subtype of `ct('b) when `'b` is a subtype of `'a`
- `in('a)` is a subtype of `in('b) when `'a` is equal to `'b`
- `bi('a)` is a subtype of `bi('b) always
- `co('a)` is a subtype of `co('b)` when `'a` is a subtype of `'b`
- `ct('a)` is a subtype of `ct('b)` when `'b` is a subtype of `'a`
- `in('a)` is a subtype of `in('b)` when `'a` is equal to `'b`
- `bi('a)` is a subtype of `bi('b)` always
That altogether induce the following rules of subtyping in Sophia:
@@ -549,6 +560,45 @@ Sophia has the following types:
| oracle_query('a, 'b) | `oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY` |
| contract | `ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ` |
## Hole expression
Hole expressions, written as `???`, are expressions that are used as a placeholder. During compilation, the compiler will generate a type error indication the type of the hole expression.
```
include "List.aes"
contract C =
entrypoint f() =
List.sum(List.map(???, [1,2,3]))
```
A hole expression found in the example above will generate the error `` Found a hole of type `(int) => int` ``. This says that the compiler expects a function from `int` to `int` in place of the `???` placeholder.
## Constants
Constants in Sophia are contract-level bindings that can be used in either contracts or namespaces. The value of a constant can be a literal, another constant, or arithmetic operations applied to other constants. Lists, tuples, maps, and records can also be used to define a constant as long as their elements are also constants.
The following visibility rules apply to constants:
* Constants defined inside a contract are private in that contract. Thus, cannot be accessed through instances of their defining contract.
* Constants defined inside a namespace are public. Thus, can be used in other contracts or namespaces.
* Constants cannot be defined inside a contract interface.
When a constant is shadowed, it can be accessed using its qualified name:
```
contract C =
let c = 1
entrypoint f() =
let c = 2
c + C.c // the result is 3
```
The name of the constant must be an id; therefore, no pattern matching is allowed when defining a constant:
```
contract C
let x::y::_ = [1,2,3] // this will result in an error
```
## Arithmetic
Sophia integers (`int`) are represented by arbitrary-sized signed words and support the following
+1 -1
View File
@@ -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
+2
View File
@@ -104,6 +104,7 @@ Implement ::= ':' Sep1(Con, ',')
Decl ::= 'type' Id ['(' TVar* ')'] '=' TypeAlias
| 'record' Id ['(' TVar* ')'] '=' RecordType
| 'datatype' Id ['(' TVar* ')'] '=' DataType
| 'let' Id [':' Type] '=' Expr
| (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
| Using
@@ -238,6 +239,7 @@ Expr ::= '(' LamArgs ')' '=>' Block(Stmt) // Anonymous function (x) => x +
| Int | Bytes | String | Char // Literals 123, 0xff, #00abc123, "foo", '%'
| AccountAddress | ContractAddress // Chain identifiers
| OracleAddress | OracleQueryId // Chain identifiers
| '???' // Hole expression 1 + ???
Generator ::= Pattern '<-' Expr // Generator
| 'if' '(' Expr ')' // Guard
+2 -2
View File
@@ -2,7 +2,7 @@
{erl_opts, [debug_info]}.
{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.1.1"}}}
{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"}}}
@@ -14,7 +14,7 @@
{base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
]}.
{relx, [{release, {aesophia, "7.0.1"},
{relx, [{release, {aesophia, "7.1.0"},
[aesophia, aebytecode, getopt]},
{dev_mode, true},
+1 -1
View File
@@ -1,7 +1,7 @@
{"1.2.0",
[{<<"aebytecode">>,
{git,"https://github.com/aeternity/aebytecode.git",
{ref,"8269dbd71e9011921c60141636f1baa270a0e784"}},
{ref,"2a0a397afad6b45da52572170f718194018bf33c"}},
0},
{<<"aeserialization">>,
{git,"https://github.com/aeternity/aeserialization.git",
+4 -4
View File
@@ -91,7 +91,7 @@ encode_contract(Contract = {Head, _, {con, _, Name}, _, _}) when ?IS_CONTRACT_HE
{Es, Tdefs1} = lists:partition(FilterT(<<"event">>), Tdefs0),
{Ss, Tdefs} = lists:partition(FilterT(<<"state">>), Tdefs1),
C1 = C0#{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_HE
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(_) -> [].
-27
View File
@@ -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]).
+519 -2877
View File
File diff suppressed because it is too large Load Diff
+85 -34
View File
@@ -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().
@@ -389,7 +397,11 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R
return => FRet,
body => FBody },
NewFuns = Funs#{ FName => Def },
Env#{ functions := NewFuns }.
Env#{ functions := NewFuns };
decl_to_fcode(Env = #{ consts := Consts }, {letval, _, {typed, _, {id, _, X}, _}, Val}) ->
FVal = expr_to_fcode(Env, Val),
NewConsts = Consts#{ qname(Env, X) => FVal },
Env#{ consts := NewConsts }.
-spec typedef_to_fcode(env(), aeso_syntax:id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> env().
typedef_to_fcode(Env, {id, _, Name}, Xs, Def) ->
@@ -1287,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 ---
@@ -1708,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
@@ -1720,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("%").
@@ -1854,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 ->
+14 -6
View File
@@ -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,
@@ -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
+123 -75
View File
@@ -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 --------------------------------------------------------------
@@ -71,16 +78,27 @@ code_error(Err) ->
%% -- 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)).
@@ -89,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) ->
@@ -149,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) ->
@@ -185,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, ""),
@@ -709,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)).
@@ -1092,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,
@@ -1119,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;
@@ -1153,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),
@@ -1186,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
@@ -1197,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
@@ -1208,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;
@@ -1219,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};
@@ -1243,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} ->
@@ -1277,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;
@@ -1296,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
@@ -1312,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} ->
@@ -1328,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,
@@ -1341,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;
@@ -1349,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]) ->
@@ -1385,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)) };
@@ -1404,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;
@@ -1423,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
@@ -1449,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
@@ -1470,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 ->
@@ -1487,7 +1535,7 @@ 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]};
+3
View File
@@ -359,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()
+5 -1
View File
@@ -261,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}) ->
@@ -288,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) ->
+1 -1
View File
@@ -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]).
+4 -3
View File
@@ -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).
+17
View File
@@ -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)}.
+593
View File
@@ -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}).
+138
View File
@@ -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).
+941
View File
@@ -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.
+499
View File
@@ -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.
+102
View File
@@ -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.
+39
View File
@@ -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).
+48
View File
@@ -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.
+248
View File
@@ -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]).
+134
View File
@@ -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.
+91
View File
@@ -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}.
+20
View File
@@ -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()}.
+190
View File
@@ -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.
+231
View File
@@ -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).
+1 -1
View File
@@ -1,6 +1,6 @@
{application, aesophia,
[{description, "Compiler for Aeternity Sophia language"},
{vsn, "7.0.1"},
{vsn, "7.1.0"},
{registered, []},
{applications,
[kernel,
+3 -3
View File
@@ -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 =>
+159 -17
View File
@@ -69,6 +69,7 @@ simple_compile_test_() ->
[ {"Testing warning messages",
fun() ->
#{ warnings := Warnings } = compile("warnings", [warn_all]),
#{ warnings := [] } = compile("warning_unused_include_no_include", [warn_all]),
check_warnings(warnings(), Warnings)
end} ] ++
[].
@@ -203,6 +204,11 @@ compilable_contracts() ->
"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",
@@ -215,6 +221,8 @@ compilable_contracts() ->
"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.
].
@@ -279,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() ->
@@ -651,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. "
@@ -731,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`">>,
@@ -840,32 +860,36 @@ 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(4,20)
"Unimplemented function `f` from the interface `I1` in the contract `I2`">>])
[<<?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 function `f` from the interface `I1` in the contract `I2`">>
"Unimplemented entrypoint `f` from the interface `I1` in the contract `I2`">>
])
, ?TYPE_ERROR(polymorphism_contract_same_decl_multi_interface,
[<<?Pos(7,10)
"Unimplemented function `f` from the interface `J` in the contract `C`">>
"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(9,5)
"Duplicate definitions of `f` at\n"
" - line 8, column 5\n"
" - line 9, column 5">>
[<<?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)
@@ -1124,6 +1148,124 @@ failing_contracts() ->
" `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">>
])
].
validation_test_() ->
+3
View File
@@ -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,
@@ -0,0 +1,5 @@
contract F =
entrypoint g() = 1
main contract C =
entrypoint f() = F.g()
+1 -10
View File
@@ -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}
+1 -6
View File
@@ -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}
+13
View File
@@ -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() = ???
@@ -0,0 +1,5 @@
contract interface I =
entrypoint f : () => int
contract C : I =
stateful entrypoint f() = 1
@@ -0,0 +1,6 @@
contract interface I =
entrypoint f : () => int
contract C : I =
entrypoint init() = ()
function f() = 1
@@ -0,0 +1,5 @@
payable contract interface I =
payable entrypoint f : () => int
contract C : I =
entrypoint f() = 123
@@ -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
@@ -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
@@ -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
@@ -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
@@ -0,0 +1,5 @@
contract interface I =
payable entrypoint f : () => int
contract C : I =
entrypoint f() = 1
@@ -0,0 +1,5 @@
payable contract interface SalesOffer =
entrypoint init : (address, address, int, int) => unit
payable contract Test : SalesOffer =
entrypoint init(_, _, _, _) = ()
@@ -0,0 +1,5 @@
payable contract interface SalesOffer =
entrypoint init : (address, address, int, int) => void
payable contract Test : SalesOffer =
entrypoint init(_ : address, _ : address, _ : int, _ : int) = ()
@@ -0,0 +1,9 @@
contract First =
entrypoint print_num(x) = 1 + x
contract Second =
entrypoint print_num() = 1
main contract Test =
entrypoint f(c) = c.print_num(1)
entrypoint g(c) = c.print_num()
-3
View File
@@ -1,7 +1,4 @@
contract interface SpendContract =
entrypoint withdraw : (int) => int
contract SpendTest =
stateful entrypoint spend(to, amount) =
+64
View File
@@ -0,0 +1,64 @@
namespace N0 =
let nsconst = 1
namespace N =
let nsconst = N0.nsconst
contract C =
datatype event = EventX(int, string)
record account = { name : string,
balance : int }
let c01 = 2425
let c02 = -5
let c03 = ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
let c04 = true
let c05 = Bits.none
let c06 = #fedcba9876543210
let c07 = "str"
let c08 = [1, 2, 3]
let c09 = [(true, 24), (false, 19), (false, -42)]
let c10 = (42, "Foo", true)
let c11 = { name = "str", balance = 100000000 }
let c12 = {["foo"] = 19, ["bar"] = 42}
let c13 = Some(42)
let c14 = 11 : int
let c15 = EventX(0, "Hello")
let c16 = #000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f
let c17 = #000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f
let c18 = RelativeTTL(50)
let c19 = ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5
let c20 = oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY
let c21 = ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ : C
let c22 = N.nsconst
let c23 = c01
let c24 = c11.name
let c25 : int = 1
entrypoint f01() = c01
entrypoint f02() = c02
entrypoint f03() = c03
entrypoint f04() = c04
entrypoint f05() = c05
entrypoint f06() = c06
entrypoint f07() = c07
entrypoint f08() = c08
entrypoint f09() = c09
entrypoint f10() = c10
entrypoint f11() = c11
entrypoint f12() = c12
entrypoint f13() = c13
entrypoint f14() = c14
entrypoint f15() = c15
entrypoint f16() = c16
entrypoint f17() = c17
entrypoint f18() = c18
entrypoint f19() = c19
entrypoint f20() = c20
entrypoint f21() = c21
entrypoint f22() = c22
entrypoint f23() = c23
entrypoint f24() = c24
entrypoint f25() = c25
entrypoint fqual() = C.c01
@@ -0,0 +1,11 @@
contract G =
let const = 1
main contract C =
let c = G.const
stateful entrypoint f() =
let g = Chain.create() : G
g.const
g.const()
@@ -0,0 +1,6 @@
contract C =
let selfcycle = selfcycle
let cycle1 = cycle2
let cycle2 = cycle3
let cycle3 = cycle1
@@ -0,0 +1,7 @@
contract interface I =
let (x::y::_) = [1,2,3]
let c = 10
let d = 10
contract C =
entrypoint init() = ()
@@ -0,0 +1,21 @@
main contract C =
record account = { name : string,
balance : int }
let one = 1
let opt = Some(5)
let acc = { name = "str", balance = 100000 }
let mpp = {["foo"] = 19, ["bar"] = 42}
let c01 = [x | x <- [1,2,3,4,5]]
let c02 = [x + k | x <- [1,2,3,4,5], let k = x*x]
let c03 = [x + y | x <- [1,2,3,4,5], let k = x*x, if (k > 5), y <- [k, k+1, k+2]]
let c04 = if (one > 2) 3 else 4
let c05 = switch (opt)
Some(x) => x
None => 2
let c07 = acc{ balance = one }
let c08 = mpp["foo"]
let c09 = mpp["non" = 10]
let c10 = mpp{["foo"] = 20}
let c11 = (x) => x + 1
@@ -0,0 +1,3 @@
contract C =
let x::_ = [1,2,3,4]
let y::(p = z::_) = [1,2,3,4]
-3
View File
@@ -1,3 +0,0 @@
contract C =
let this_is_illegal = 2/0
entrypoint this_is_legal() = 2/0
@@ -0,0 +1,7 @@
contract F =
entrypoint g() = 1
main contract C =
using F for [g]
entrypoint f() = g()
@@ -0,0 +1,7 @@
contract C =
stateful function g(h) =
h()
stateful entrypoint f() =
g(Chain.create)
123
+4
View File
@@ -0,0 +1,4 @@
main contract C =
stateful entrypoint f() =
let x = Chain.clone
123
@@ -0,0 +1,5 @@
namespace N =
function nconst() = 1
main contract C =
entrypoint f() = N.nconst()
+29 -1
View File
@@ -12,7 +12,7 @@ namespace UnusedNamespace =
// Unused
private function h() = 3
contract Warnings =
main contract Warnings =
type state = int
@@ -58,3 +58,31 @@ namespace FunctionsAsArgs =
private function inc(n : int) : int = n + 1
// Never used
private function dec(n : int) : int = n - 1
contract Remote =
entrypoint id(_) = 0
contract C =
payable stateful entrypoint
call_missing_con() : int = (ct_1111111111111111111111111111112JF6Dz72 : Remote).id(value = 1, 0)
namespace ShadowingConst =
let const = 1
function f() =
let const = 2
const
namespace UnusedConstNamespace =
// No warnings should be shown even though const is not used
let const = 1
contract UnusedConstContract =
// Only `c` should show a warning because it is never used in the contract
let a = 1
let b = 2
let c = 3
entrypoint f() =
// Both normal access and qualified access should prevent the unused const warning
a + UnusedConstContract.b