Compare commits
5 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Gaith Hallak
|
b902226c26 | ||
|
Hans Svensson
|
c1e8195fd8 | ||
|
Hans Svensson
|
d5ff9d4a2f | ||
|
Gaith Hallak
|
c395849684 | ||
|
Hans Svensson
|
7bac15949c |
+10
-2
@@ -6,6 +6,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||
|
||||
## [Unreleased]
|
||||
### Added
|
||||
### Changed
|
||||
### Removed
|
||||
### Fixed
|
||||
|
||||
## [7.2.0]
|
||||
### Added
|
||||
- Toplevel compile-time constants
|
||||
```
|
||||
namespace N =
|
||||
@@ -13,8 +19,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||
contract C =
|
||||
let cc = 2
|
||||
```
|
||||
### Changed
|
||||
- API functions for encoding/decoding Sophia values to/from FATE.
|
||||
### Removed
|
||||
- Remove the mapping from variables to FATE registers from the compilation output.
|
||||
### Fixed
|
||||
- Warning about unused include when there is no include.
|
||||
|
||||
@@ -388,7 +395,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.1.0...HEAD
|
||||
[Unreleased]: https://github.com/aeternity/aesophia/compare/v7.2.0...HEAD
|
||||
[7.2.0]: https://github.com/aeternity/aesophia/compare/v7.1.0...v7.2.0
|
||||
[7.1.0]: https://github.com/aeternity/aesophia/compare/v7.0.1...v7.1.0
|
||||
[7.0.1]: https://github.com/aeternity/aesophia/compare/v7.0.0...v7.0.1
|
||||
[7.0.0]: https://github.com/aeternity/aesophia/compare/v6.1.0...v7.0.0
|
||||
|
||||
@@ -53,8 +53,6 @@ The **pp_** options all print to standard output the following:
|
||||
|
||||
The option `include_child_contract_symbols` includes the symbols of child contracts functions in the generated fate code. It is turned off by default to avoid making contracts bigger on chain.
|
||||
|
||||
The option `debug_info` includes information related to debugging in the compiler output. Currently this option only includes the mapping from variables to registers.
|
||||
|
||||
#### Options to control which compiler optimizations should run:
|
||||
|
||||
By default all optimizations are turned on, to disable an optimization, it should be
|
||||
|
||||
+46
-34
@@ -190,7 +190,7 @@ using the private key of the `owner` account for signing.
|
||||
##### update
|
||||
```
|
||||
AENS.update(owner : address, name : string, expiry : option(Chain.ttl), client_ttl : option(int),
|
||||
new_ptrs : map(string, AENS.pointee), <signature : signature>) : unit
|
||||
new_ptrs : option(map(string, AENS.pointee)), <signature : signature>) : unit
|
||||
```
|
||||
|
||||
Updates the name. If the optional parameters are set to `None` that parameter
|
||||
@@ -470,38 +470,6 @@ Chain.block_height : int"
|
||||
The height of the current block (i.e. the block in which the current call will be included).
|
||||
|
||||
|
||||
##### coinbase
|
||||
```
|
||||
Chain.coinbase : address
|
||||
```
|
||||
|
||||
The address of the account that mined the current block.
|
||||
|
||||
|
||||
##### timestamp
|
||||
```
|
||||
Chain.timestamp : int
|
||||
```
|
||||
|
||||
The timestamp of the current block (unix time, milliseconds).
|
||||
|
||||
|
||||
##### difficulty
|
||||
```
|
||||
Chain.difficulty : int
|
||||
```
|
||||
|
||||
The difficulty of the current block.
|
||||
|
||||
|
||||
##### gas
|
||||
```
|
||||
Chain.gas_limit : int
|
||||
```
|
||||
|
||||
The gas limit of the current block.
|
||||
|
||||
|
||||
##### bytecode_hash
|
||||
```
|
||||
Chain.bytecode_hash : 'c => option(hash)
|
||||
@@ -565,6 +533,7 @@ main contract Market =
|
||||
The typechecker must be certain about the created contract's type, so it is
|
||||
worth writing it explicitly as shown in the example.
|
||||
|
||||
|
||||
##### clone
|
||||
```
|
||||
Chain.clone : ( ref : 'c, gas : int, value : int, protected : bool, ...
|
||||
@@ -623,11 +592,54 @@ implementation of the `init` function does not actually return `state`, but
|
||||
calls `put` instead. Moreover, FATE prevents even handcrafted calls to `init`.
|
||||
|
||||
|
||||
##### coinbase
|
||||
```
|
||||
Chain.coinbase : address
|
||||
```
|
||||
|
||||
The address of the account that mined the current block.
|
||||
|
||||
|
||||
##### difficulty
|
||||
```
|
||||
Chain.difficulty : int
|
||||
```
|
||||
|
||||
The difficulty of the current block.
|
||||
|
||||
|
||||
##### event
|
||||
```
|
||||
Chain.event(e : event) : unit
|
||||
```
|
||||
Emits the event. To use this function one needs to define the `event` type as a `datatype` in the contract.
|
||||
|
||||
Emits the event. To use this function one needs to define the `event` type as a
|
||||
`datatype` in the contract.
|
||||
|
||||
|
||||
##### gas\_limit
|
||||
```
|
||||
Chain.gas_limit : int
|
||||
```
|
||||
|
||||
The gas limit of the current block.
|
||||
|
||||
|
||||
##### spend
|
||||
```
|
||||
Chain.spend(to : address, amount : int) : unit
|
||||
```
|
||||
|
||||
Spend `amount` tokens to `to`. Will fail (and abort the contract) if contract
|
||||
doesn't have `amount` tokens to transfer, or, if `to` is not `payable`.
|
||||
|
||||
|
||||
##### timestamp
|
||||
```
|
||||
Chain.timestamp : int
|
||||
```
|
||||
|
||||
The timestamp of the current block (unix time, milliseconds).
|
||||
|
||||
|
||||
### Char
|
||||
|
||||
+2
-3
@@ -2,8 +2,7 @@
|
||||
|
||||
{erl_opts, [debug_info]}.
|
||||
|
||||
{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.2.0"}}}
|
||||
, {getopt, "1.0.1"}
|
||||
{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.3.0"}}}
|
||||
, {eblake2, "1.0.0"}
|
||||
, {jsx, {git, "https://github.com/talentdeficit/jsx.git", {tag, "2.8.0"}}}
|
||||
]}.
|
||||
@@ -14,7 +13,7 @@
|
||||
{base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
|
||||
]}.
|
||||
|
||||
{relx, [{release, {aesophia, "7.1.0"},
|
||||
{relx, [{release, {aesophia, "7.2.0"},
|
||||
[aesophia, aebytecode, getopt]},
|
||||
|
||||
{dev_mode, true},
|
||||
|
||||
+3
-3
@@ -1,11 +1,11 @@
|
||||
{"1.2.0",
|
||||
[{<<"aebytecode">>,
|
||||
{git,"https://github.com/aeternity/aebytecode.git",
|
||||
{ref,"2a0a397afad6b45da52572170f718194018bf33c"}},
|
||||
{ref,"b38349274fc2bed98d7fe86877e6e1a2df302109"}},
|
||||
0},
|
||||
{<<"aeserialization">>,
|
||||
{git,"https://github.com/aeternity/aeserialization.git",
|
||||
{ref,"eb68fe331bd476910394966b7f5ede7a74d37e35"}},
|
||||
{ref,"177bf604b2a05e940f92cf00e96e6e269e708245"}},
|
||||
1},
|
||||
{<<"base58">>,
|
||||
{git,"https://github.com/aeternity/erl-base58.git",
|
||||
@@ -16,7 +16,7 @@
|
||||
{git,"https://github.com/aeternity/enacl.git",
|
||||
{ref,"793ddb502f7fe081302e1c42227dca70b09f8e17"}},
|
||||
2},
|
||||
{<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0},
|
||||
{<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},1},
|
||||
{<<"jsx">>,
|
||||
{git,"https://github.com/talentdeficit/jsx.git",
|
||||
{ref,"3074d4865b3385a050badf7828ad31490d860df5"}},
|
||||
|
||||
@@ -0,0 +1,27 @@
|
||||
-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]).
|
||||
|
||||
+3017
-303
File diff suppressed because it is too large
Load Diff
+689
-504
File diff suppressed because it is too large
Load Diff
+76
-35
@@ -12,6 +12,8 @@
|
||||
, file/2
|
||||
, from_string/2
|
||||
, check_call/4
|
||||
, decode_value/4
|
||||
, encode_value/4
|
||||
, create_calldata/3
|
||||
, create_calldata/4
|
||||
, version/0
|
||||
@@ -117,7 +119,7 @@ from_string1(ContractString, Options) ->
|
||||
, warnings := Warnings } = string_to_code(ContractString, Options),
|
||||
#{ child_con_env := ChildContracts } = FCodeEnv,
|
||||
SavedFreshNames = maps:get(saved_fresh_names, FCodeEnv, #{}),
|
||||
{FateCode, VarsRegs} = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
|
||||
FateCode = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
|
||||
pp_assembler(FateCode, Options),
|
||||
ByteCode = aeb_fate_code:serialize(FateCode, []),
|
||||
{ok, Version} = version(),
|
||||
@@ -130,13 +132,7 @@ from_string1(ContractString, Options) ->
|
||||
payable => maps:get(payable, FCode),
|
||||
warnings => Warnings
|
||||
},
|
||||
ResDbg = Res#{variables_registers => VarsRegs},
|
||||
FinalRes =
|
||||
case proplists:get_value(debug_info, Options, false) of
|
||||
true -> ResDbg;
|
||||
false -> Res
|
||||
end,
|
||||
{ok, maybe_generate_aci(FinalRes, FoldedTypedAst, Options)}.
|
||||
{ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}.
|
||||
|
||||
maybe_generate_aci(Result, FoldedTypedAst, Options) ->
|
||||
case proplists:get_value(aci, Options) of
|
||||
@@ -188,30 +184,55 @@ check_call(Source, FunName, Args, Options) ->
|
||||
check_call1(Source, FunName, Args, Options).
|
||||
|
||||
check_call1(ContractString0, FunName, Args, Options) ->
|
||||
case add_extra_call(ContractString0, {call, FunName, Args}, Options) of
|
||||
{ok, CallName, Code} ->
|
||||
{def, _, _, FcodeArgs} = get_call_body(CallName, Code),
|
||||
{ok, FunName, [ aeso_fcode_to_fate:term_to_fate(A) || A <- FcodeArgs ]};
|
||||
Err = {error, _} ->
|
||||
Err
|
||||
end.
|
||||
|
||||
add_extra_call(Contract0, Call, Options) ->
|
||||
try
|
||||
%% First check the contract without the __call function
|
||||
#{fcode := OrgFcode
|
||||
, fcode_env := #{child_con_env := ChildContracts}
|
||||
, ast := Ast} = string_to_code(ContractString0, Options),
|
||||
{FateCode, _} = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
|
||||
, ast := Ast} = string_to_code(Contract0, Options),
|
||||
FateCode = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
|
||||
%% collect all hashes and compute the first name without hash collision to
|
||||
SymbolHashes = maps:keys(aeb_fate_code:symbols(FateCode)),
|
||||
CallName = first_none_match(?CALL_NAME, SymbolHashes,
|
||||
lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)),
|
||||
ContractString = insert_call_function(Ast, ContractString0, CallName, FunName, Args),
|
||||
#{fcode := Fcode} = string_to_code(ContractString, Options),
|
||||
CallArgs = arguments_of_body(CallName, FunName, Fcode),
|
||||
|
||||
{ok, FunName, CallArgs}
|
||||
Contract = insert_call_function(Ast, Contract0, CallName, Call),
|
||||
{ok, CallName, string_to_code(Contract, Options)}
|
||||
catch
|
||||
throw:{error, Errors} -> {error, Errors}
|
||||
end.
|
||||
|
||||
arguments_of_body(CallName, _FunName, Fcode) ->
|
||||
get_call_body(CallName, #{fcode := Fcode}) ->
|
||||
#{body := Body} = maps:get({entrypoint, list_to_binary(CallName)}, maps:get(functions, Fcode)),
|
||||
{def, _FName, Args} = Body,
|
||||
%% FName is either {entrypoint, list_to_binary(FunName)} or 'init'
|
||||
[ aeso_fcode_to_fate:term_to_fate(A) || A <- Args ].
|
||||
Body.
|
||||
|
||||
encode_value(Contract0, Type, Value, Options) ->
|
||||
case add_extra_call(Contract0, {value, Type, Value}, Options) of
|
||||
{ok, CallName, Code} ->
|
||||
Body = get_call_body(CallName, Code),
|
||||
{ok, aeb_fate_encoding:serialize(aeso_fcode_to_fate:term_to_fate(Body))};
|
||||
Err = {error, _} ->
|
||||
Err
|
||||
end.
|
||||
|
||||
decode_value(Contract0, Type, FateValue, Options) ->
|
||||
case add_extra_call(Contract0, {type, Type}, Options) of
|
||||
{ok, CallName, Code} ->
|
||||
#{ unfolded_typed_ast := TypedAst
|
||||
, type_env := TypeEnv} = Code,
|
||||
{ok, _, Type0} = get_decode_type(CallName, TypedAst),
|
||||
Type1 = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
|
||||
fate_data_to_sophia_value(Type0, Type1, FateValue);
|
||||
Err = {error, _} ->
|
||||
Err
|
||||
end.
|
||||
|
||||
first_none_match(_CallName, _Hashes, []) ->
|
||||
error(unable_to_find_unique_call_name);
|
||||
@@ -224,14 +245,31 @@ first_none_match(CallName, Hashes, [Char|Chars]) ->
|
||||
end.
|
||||
|
||||
%% Add the __call function to a contract.
|
||||
-spec insert_call_function(aeso_syntax:ast(), string(), string(), string(), [string()]) -> string().
|
||||
insert_call_function(Ast, Code, Call, FunName, Args) ->
|
||||
-spec insert_call_function(aeso_syntax:ast(), string(), string(),
|
||||
{call, string(), [string()]} | {value, string(), string()} | {type, string()}) -> string().
|
||||
insert_call_function(Ast, Code, Call, {call, FunName, Args}) ->
|
||||
Ind = last_contract_indent(Ast),
|
||||
lists:flatten(
|
||||
[ Code,
|
||||
"\n\n",
|
||||
lists:duplicate(Ind, " "),
|
||||
"stateful entrypoint ", Call, "() = ", FunName, "(", string:join(Args, ","), ")\n"
|
||||
]);
|
||||
insert_call_function(Ast, Code, Call, {value, Type, Value}) ->
|
||||
Ind = last_contract_indent(Ast),
|
||||
lists:flatten(
|
||||
[ Code,
|
||||
"\n\n",
|
||||
lists:duplicate(Ind, " "),
|
||||
"entrypoint ", Call, "() : ", Type, " = ", Value, "\n"
|
||||
]);
|
||||
insert_call_function(Ast, Code, Call, {type, Type}) ->
|
||||
Ind = last_contract_indent(Ast),
|
||||
lists:flatten(
|
||||
[ Code,
|
||||
"\n\n",
|
||||
lists:duplicate(Ind, " "),
|
||||
"entrypoint ", Call, "(val : ", Type, ") = val\n"
|
||||
]).
|
||||
|
||||
-spec insert_init_function(string(), options()) -> string().
|
||||
@@ -272,24 +310,27 @@ 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_tc_type_unfolding:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
|
||||
Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
|
||||
|
||||
try
|
||||
{ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))}
|
||||
catch throw:cannot_translate_to_sophia ->
|
||||
Type1 = prettypr:format(aeso_pretty:type(Type0)),
|
||||
Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s",
|
||||
[aeb_fate_encoding:deserialize(Data), Type1]),
|
||||
{error, [aeso_errors:new(data_error, Msg)]};
|
||||
_:_ ->
|
||||
Type1 = prettypr:format(aeso_pretty:type(Type0)),
|
||||
Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]),
|
||||
{error, [aeso_errors:new(data_error, Msg)]}
|
||||
end
|
||||
fate_data_to_sophia_value(Type0, Type, Data)
|
||||
catch
|
||||
throw:{error, Errors} -> {error, Errors}
|
||||
end.
|
||||
|
||||
fate_data_to_sophia_value(Type, UnfoldedType, FateData) ->
|
||||
try
|
||||
{ok, aeso_vm_decode:from_fate(UnfoldedType, aeb_fate_encoding:deserialize(FateData))}
|
||||
catch throw:cannot_translate_to_sophia ->
|
||||
Type1 = prettypr:format(aeso_pretty:type(Type)),
|
||||
Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s",
|
||||
[aeb_fate_encoding:deserialize(FateData), Type1]),
|
||||
{error, [aeso_errors:new(data_error, Msg)]};
|
||||
_:_ ->
|
||||
Type1 = prettypr:format(aeso_pretty:type(Type)),
|
||||
Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]),
|
||||
{error, [aeso_errors:new(data_error, Msg)]}
|
||||
end.
|
||||
|
||||
-spec create_calldata(string(), string(), [string()]) ->
|
||||
{ok, binary()} | {error, [aeso_errors:error()]}.
|
||||
create_calldata(Code, Fun, Args) ->
|
||||
@@ -323,7 +364,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_tc_type_unfolding:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
|
||||
Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
|
||||
case aeb_fate_abi:decode_calldata(FunName, Calldata) of
|
||||
{ok, FateArgs} ->
|
||||
try
|
||||
|
||||
+193
-117
@@ -52,7 +52,8 @@
|
||||
tailpos = true,
|
||||
child_contracts = #{},
|
||||
saved_fresh_names = #{},
|
||||
options = [] }).
|
||||
options = [],
|
||||
debug_info = false }).
|
||||
|
||||
%% -- Debugging --------------------------------------------------------------
|
||||
|
||||
@@ -81,24 +82,16 @@ code_error(Err) ->
|
||||
compile(FCode, SavedFreshNames, Options) ->
|
||||
compile(#{}, FCode, SavedFreshNames, Options).
|
||||
compile(ChildContracts, FCode, SavedFreshNames, Options) ->
|
||||
try
|
||||
compile1(ChildContracts, FCode, SavedFreshNames, Options)
|
||||
after
|
||||
put(variables_registers, undefined)
|
||||
end.
|
||||
|
||||
compile1(ChildContracts, FCode, SavedFreshNames, Options) ->
|
||||
#{ contract_name := ContractName,
|
||||
functions := Functions } = FCode,
|
||||
SFuns = functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Options),
|
||||
SFuns1 = optimize_scode(SFuns, Options),
|
||||
FateCode = to_basic_blocks(SFuns1),
|
||||
?debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]),
|
||||
FateCode1 = case proplists:get_value(include_child_contract_symbols, Options, false) of
|
||||
false -> FateCode;
|
||||
true -> add_child_symbols(ChildContracts, FateCode)
|
||||
end,
|
||||
{FateCode1, get_variables_registers()}.
|
||||
case proplists:get_value(include_child_contract_symbols, Options, false) of
|
||||
false -> FateCode;
|
||||
true -> add_child_symbols(ChildContracts, FateCode)
|
||||
end.
|
||||
|
||||
make_function_id(X) ->
|
||||
aeb_fate_code:symbol_identifier(make_function_name(X)).
|
||||
@@ -123,31 +116,15 @@ functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Opt
|
||||
|
||||
function_to_scode(ChildContracts, ContractName, Functions, Name, Attrs0, Args, Body, ResType, SavedFreshNames, Options) ->
|
||||
{ArgTypes, ResType1} = typesig_to_scode(Args, ResType),
|
||||
Attrs = Attrs0 -- [stateful], %% Only track private and payable from here.
|
||||
Attrs = [ A || A <- Attrs0, A == private orelse A == payable ],
|
||||
Env = init_env(ChildContracts, ContractName, Functions, Name, Args, SavedFreshNames, Options),
|
||||
[ add_variables_register(Env, Arg, Register) ||
|
||||
proplists:get_value(debug_info, Options, false),
|
||||
{Arg, Register} <- Env#env.vars ],
|
||||
ArgsNames = [ X || {X, _} <- lists:reverse(Env#env.vars) ],
|
||||
|
||||
%% DBG_LOC is added before the function body to make it possible to break
|
||||
%% at the function signature
|
||||
SCode = to_scode(Env, Body),
|
||||
{Attrs, {ArgTypes, ResType1}, SCode}.
|
||||
|
||||
get_variables_registers() ->
|
||||
case get(variables_registers) of
|
||||
undefined -> #{};
|
||||
Vs -> Vs
|
||||
end.
|
||||
|
||||
add_variables_register(Env = #env{saved_fresh_names = SavedFreshNames}, Name, Register) ->
|
||||
Olds = get_variables_registers(),
|
||||
RealName = maps:get(Name, SavedFreshNames, Name),
|
||||
FunName =
|
||||
case Env#env.current_function of
|
||||
event -> "Chain.event";
|
||||
{entrypoint, BinName} -> binary_to_list(BinName);
|
||||
{local_fun, QualName} -> lists:last(QualName)
|
||||
end,
|
||||
New = {Env#env.contract, FunName, RealName},
|
||||
put(variables_registers, Olds#{New => Register}).
|
||||
DbgSCode = dbg_contract(Env) ++ dbg_loc(Env, Attrs0) ++ dbg_scoped_vars(Env, ArgsNames, SCode),
|
||||
{Attrs, {ArgTypes, ResType1}, DbgSCode}.
|
||||
|
||||
-define(tvars, '$tvars').
|
||||
|
||||
@@ -194,20 +171,20 @@ types_to_scode(Ts) -> lists:map(fun type_to_scode/1, Ts).
|
||||
%% -- Environment functions --
|
||||
|
||||
init_env(ChildContracts, ContractName, FunNames, Name, Args, SavedFreshNames, Options) ->
|
||||
#env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ],
|
||||
contract = ContractName,
|
||||
child_contracts = ChildContracts,
|
||||
locals = FunNames,
|
||||
current_function = Name,
|
||||
options = Options,
|
||||
tailpos = true,
|
||||
saved_fresh_names = SavedFreshNames }.
|
||||
#env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ],
|
||||
contract = ContractName,
|
||||
child_contracts = ChildContracts,
|
||||
locals = FunNames,
|
||||
current_function = Name,
|
||||
options = Options,
|
||||
tailpos = true,
|
||||
saved_fresh_names = SavedFreshNames,
|
||||
debug_info = proplists:get_value(debug_info, Options, false) }.
|
||||
|
||||
next_var(#env{ vars = Vars }) ->
|
||||
1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]).
|
||||
|
||||
bind_var(Name, Var, Env = #env{ vars = Vars }) ->
|
||||
proplists:get_value(debug_info, Env#env.options, false) andalso add_variables_register(Env, Name, Var),
|
||||
Env#env{ vars = [{Name, Var} | Vars] }.
|
||||
|
||||
bind_local(Name, Env) ->
|
||||
@@ -234,7 +211,7 @@ serialize_contract_code(Env, C) ->
|
||||
Options = Env#env.options,
|
||||
SavedFreshNames = Env#env.saved_fresh_names,
|
||||
FCode = maps:get(C, Env#env.child_contracts),
|
||||
{FateCode, _} = compile1(Env#env.child_contracts, FCode, SavedFreshNames, Options),
|
||||
FateCode = compile(Env#env.child_contracts, FCode, SavedFreshNames, Options),
|
||||
ByteCode = aeb_fate_code:serialize(FateCode, []),
|
||||
{ok, Version} = aeso_compiler:version(),
|
||||
OriginalSourceCode = proplists:get_value(original_src, Options, ""),
|
||||
@@ -268,44 +245,44 @@ lit_to_fate(Env, L) ->
|
||||
term_to_fate(E) -> term_to_fate(#env{}, #{}, E).
|
||||
term_to_fate(GlobEnv, E) -> term_to_fate(GlobEnv, #{}, E).
|
||||
|
||||
term_to_fate(GlobEnv, _Env, {lit, L}) ->
|
||||
term_to_fate(GlobEnv, _Env, {lit, _, L}) ->
|
||||
lit_to_fate(GlobEnv, L);
|
||||
%% negative literals are parsed as 0 - N
|
||||
term_to_fate(_GlobEnv, _Env, {op, '-', [{lit, {int, 0}}, {lit, {int, N}}]}) ->
|
||||
term_to_fate(_GlobEnv, _Env, {op, _, '-', [{lit, _, {int, 0}}, {lit, _, {int, N}}]}) ->
|
||||
aeb_fate_data:make_integer(-N);
|
||||
term_to_fate(_GlobEnv, _Env, nil) ->
|
||||
term_to_fate(_GlobEnv, _Env, {nil, _}) ->
|
||||
aeb_fate_data:make_list([]);
|
||||
term_to_fate(GlobEnv, Env, {op, '::', [Hd, Tl]}) ->
|
||||
term_to_fate(GlobEnv, Env, {op, _, '::', [Hd, Tl]}) ->
|
||||
%% The Tl will translate into a list, because FATE lists are just lists
|
||||
[term_to_fate(GlobEnv, Env, Hd) | term_to_fate(GlobEnv, Env, Tl)];
|
||||
term_to_fate(GlobEnv, Env, {tuple, As}) ->
|
||||
term_to_fate(GlobEnv, Env, {tuple, _, As}) ->
|
||||
aeb_fate_data:make_tuple(list_to_tuple([ term_to_fate(GlobEnv, Env, A) || A<-As]));
|
||||
term_to_fate(GlobEnv, Env, {con, Ar, I, As}) ->
|
||||
term_to_fate(GlobEnv, Env, {con, _, Ar, I, As}) ->
|
||||
FateAs = [ term_to_fate(GlobEnv, Env, A) || A <- As ],
|
||||
aeb_fate_data:make_variant(Ar, I, list_to_tuple(FateAs));
|
||||
term_to_fate(_GlobEnv, _Env, {builtin, bits_all, []}) ->
|
||||
term_to_fate(_GlobEnv, _Env, {builtin, _, bits_all, []}) ->
|
||||
aeb_fate_data:make_bits(-1);
|
||||
term_to_fate(_GlobEnv, _Env, {builtin, bits_none, []}) ->
|
||||
term_to_fate(_GlobEnv, _Env, {builtin, _, bits_none, []}) ->
|
||||
aeb_fate_data:make_bits(0);
|
||||
term_to_fate(GlobEnv, _Env, {op, bits_set, [B, I]}) ->
|
||||
term_to_fate(GlobEnv, _Env, {op, _, bits_set, [B, I]}) ->
|
||||
{bits, N} = term_to_fate(GlobEnv, B),
|
||||
J = term_to_fate(GlobEnv, I),
|
||||
{bits, N bor (1 bsl J)};
|
||||
term_to_fate(GlobEnv, _Env, {op, bits_clear, [B, I]}) ->
|
||||
term_to_fate(GlobEnv, _Env, {op, _, bits_clear, [B, I]}) ->
|
||||
{bits, N} = term_to_fate(GlobEnv, B),
|
||||
J = term_to_fate(GlobEnv, I),
|
||||
{bits, N band bnot (1 bsl J)};
|
||||
term_to_fate(GlobEnv, Env, {'let', X, E, Body}) ->
|
||||
term_to_fate(GlobEnv, Env, {'let', _, X, E, Body}) ->
|
||||
Env1 = Env#{ X => term_to_fate(GlobEnv, Env, E) },
|
||||
term_to_fate(GlobEnv, Env1, Body);
|
||||
term_to_fate(_GlobEnv, Env, {var, X}) ->
|
||||
term_to_fate(_GlobEnv, Env, {var, _, X}) ->
|
||||
case maps:get(X, Env, undefined) of
|
||||
undefined -> throw(not_a_fate_value);
|
||||
V -> V
|
||||
end;
|
||||
term_to_fate(_GlobEnv, _Env, {builtin, map_empty, []}) ->
|
||||
term_to_fate(_GlobEnv, _Env, {builtin, _, map_empty, []}) ->
|
||||
aeb_fate_data:make_map(#{});
|
||||
term_to_fate(GlobEnv, Env, {op, map_set, [M, K, V]}) ->
|
||||
term_to_fate(GlobEnv, Env, {op, _, map_set, [M, K, V]}) ->
|
||||
Map = term_to_fate(GlobEnv, Env, M),
|
||||
Map#{term_to_fate(GlobEnv, Env, K) => term_to_fate(GlobEnv, Env, V)};
|
||||
term_to_fate(_GlobEnv, _Env, _) ->
|
||||
@@ -313,52 +290,59 @@ term_to_fate(_GlobEnv, _Env, _) ->
|
||||
|
||||
to_scode(Env, T) ->
|
||||
try term_to_fate(Env, T) of
|
||||
V -> [push(?i(V))]
|
||||
V ->
|
||||
FAnn = element(2, T),
|
||||
[dbg_loc(Env, FAnn), push(?i(V))]
|
||||
catch throw:not_a_fate_value ->
|
||||
to_scode1(Env, T)
|
||||
end.
|
||||
|
||||
to_scode1(Env, {lit, L}) ->
|
||||
[push(?i(lit_to_fate(Env, L)))];
|
||||
to_scode1(Env, {lit, Ann, L}) ->
|
||||
[ dbg_loc(Env, Ann), push(?i(lit_to_fate(Env, L))) ];
|
||||
|
||||
to_scode1(_Env, nil) ->
|
||||
[aeb_fate_ops:nil(?a)];
|
||||
to_scode1(Env, {nil, Ann}) ->
|
||||
[ dbg_loc(Env, Ann), aeb_fate_ops:nil(?a) ];
|
||||
|
||||
to_scode1(Env, {var, X}) ->
|
||||
[push(lookup_var(Env, X))];
|
||||
to_scode1(Env, {var, Ann, X}) ->
|
||||
[ dbg_loc(Env, Ann), push(lookup_var(Env, X)) ];
|
||||
|
||||
to_scode1(Env, {con, Ar, I, As}) ->
|
||||
to_scode1(Env, {con, Ann, Ar, I, As}) ->
|
||||
N = length(As),
|
||||
[[to_scode(notail(Env), A) || A <- As],
|
||||
aeb_fate_ops:variant(?a, ?i(Ar), ?i(I), ?i(N))];
|
||||
[ dbg_loc(Env, Ann),
|
||||
[to_scode(notail(Env), A) || A <- As],
|
||||
aeb_fate_ops:variant(?a, ?i(Ar), ?i(I), ?i(N)) ];
|
||||
|
||||
to_scode1(Env, {tuple, As}) ->
|
||||
to_scode1(Env, {tuple, Ann, As}) ->
|
||||
N = length(As),
|
||||
[[ to_scode(notail(Env), A) || A <- As ],
|
||||
tuple(N)];
|
||||
[ dbg_loc(Env, Ann),
|
||||
[ to_scode(notail(Env), A) || A <- As ],
|
||||
tuple(N) ];
|
||||
|
||||
to_scode1(Env, {proj, E, I}) ->
|
||||
[to_scode(notail(Env), E),
|
||||
aeb_fate_ops:element_op(?a, ?i(I), ?a)];
|
||||
to_scode1(Env, {proj, Ann, E, I}) ->
|
||||
[ dbg_loc(Env, Ann),
|
||||
to_scode(notail(Env), E),
|
||||
aeb_fate_ops:element_op(?a, ?i(I), ?a) ];
|
||||
|
||||
to_scode1(Env, {set_proj, R, I, E}) ->
|
||||
[to_scode(notail(Env), E),
|
||||
to_scode(notail(Env), R),
|
||||
aeb_fate_ops:setelement(?a, ?i(I), ?a, ?a)];
|
||||
to_scode1(Env, {set_proj, Ann, R, I, E}) ->
|
||||
[ dbg_loc(Env, Ann),
|
||||
to_scode(notail(Env), E),
|
||||
to_scode(notail(Env), R),
|
||||
aeb_fate_ops:setelement(?a, ?i(I), ?a, ?a) ];
|
||||
|
||||
to_scode1(Env, {op, Op, Args}) ->
|
||||
call_to_scode(Env, op_to_scode(Op), Args);
|
||||
to_scode1(Env, {op, Ann, Op, Args}) ->
|
||||
[ dbg_loc(Env, Ann) | call_to_scode(Env, op_to_scode(Op), Args) ];
|
||||
|
||||
to_scode1(Env, {'let', X, {var, Y}, Body}) ->
|
||||
to_scode1(Env, {'let', Ann, X, {var, _, Y}, Body}) ->
|
||||
Env1 = bind_var(X, lookup_var(Env, Y), Env),
|
||||
to_scode(Env1, Body);
|
||||
to_scode1(Env, {'let', X, Expr, Body}) ->
|
||||
[ dbg_loc(Env, Ann) | dbg_scoped_vars(Env1, [X], to_scode(Env1, Body)) ];
|
||||
to_scode1(Env, {'let', Ann, X, Expr, Body}) ->
|
||||
{I, Env1} = bind_local(X, Env),
|
||||
[ to_scode(notail(Env), Expr),
|
||||
aeb_fate_ops:store({var, I}, {stack, 0}),
|
||||
to_scode(Env1, Body) ];
|
||||
SCode = [ to_scode(notail(Env), Expr),
|
||||
aeb_fate_ops:store({var, I}, {stack, 0}),
|
||||
to_scode(Env1, Body) ],
|
||||
[ dbg_loc(Env, Ann) | dbg_scoped_vars(Env1, [X], SCode) ];
|
||||
|
||||
to_scode1(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) ->
|
||||
to_scode1(Env = #env{ current_function = Fun, tailpos = true, debug_info = false }, {def, Ann, Fun, Args}) ->
|
||||
%% Tail-call to current function, f(e0..en). Compile to
|
||||
%% [ let xi = ei ]
|
||||
%% [ STORE argi xi ]
|
||||
@@ -371,61 +355,62 @@ to_scode1(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}
|
||||
aeb_fate_ops:store({var, I}, ?a)],
|
||||
{[I | Is], Acc1, Env2}
|
||||
end, {[], [], Env}, Args),
|
||||
[ Code,
|
||||
[ dbg_loc(Env, Ann),
|
||||
Code,
|
||||
[ aeb_fate_ops:store({arg, I}, {var, J})
|
||||
|| {I, J} <- lists:zip(lists:seq(0, length(Vars) - 1),
|
||||
lists:reverse(Vars)) ],
|
||||
loop ];
|
||||
to_scode1(Env, {def, Fun, Args}) ->
|
||||
to_scode1(Env, {def, Ann, Fun, Args}) ->
|
||||
FName = make_function_id(Fun),
|
||||
Lbl = aeb_fate_data:make_string(FName),
|
||||
call_to_scode(Env, local_call(Env, ?i(Lbl)), Args);
|
||||
to_scode1(Env, {funcall, Fun, Args}) ->
|
||||
call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args);
|
||||
[ dbg_loc(Env, Ann) | call_to_scode(Env, local_call(Env, ?i(Lbl)), Args) ];
|
||||
to_scode1(Env, {funcall, Ann, Fun, Args}) ->
|
||||
[ dbg_loc(Env, Ann) | call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args) ];
|
||||
|
||||
to_scode1(Env, {builtin, B, Args}) ->
|
||||
builtin_to_scode(Env, B, Args);
|
||||
to_scode1(Env, {builtin, Ann, B, Args}) ->
|
||||
[ dbg_loc(Env, Ann) | builtin_to_scode(Env, B, Args) ];
|
||||
|
||||
to_scode1(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value, Protected | Args]}) ->
|
||||
to_scode1(Env, {remote, Ann, ArgsT, RetT, Ct, Fun, [Gas, Value, Protected | Args]}) ->
|
||||
Lbl = make_function_id(Fun),
|
||||
{ArgTypes, RetType0} = typesig_to_scode([{"_", T} || T <- ArgsT], RetT),
|
||||
ArgType = ?i(aeb_fate_data:make_typerep({tuple, ArgTypes})),
|
||||
RetType = ?i(aeb_fate_data:make_typerep(RetType0)),
|
||||
case Protected of
|
||||
{lit, {bool, false}} ->
|
||||
SCode = case Protected of
|
||||
{lit, _, {bool, false}} ->
|
||||
case Gas of
|
||||
{builtin, call_gas_left, _} ->
|
||||
{builtin, _, call_gas_left, _} ->
|
||||
Call = aeb_fate_ops:call_r(?a, Lbl, ArgType, RetType, ?a),
|
||||
call_to_scode(Env, Call, [Ct, Value | Args]);
|
||||
_ ->
|
||||
Call = aeb_fate_ops:call_gr(?a, Lbl, ArgType, RetType, ?a, ?a),
|
||||
call_to_scode(Env, Call, [Ct, Value, Gas | Args])
|
||||
end;
|
||||
{lit, {bool, true}} ->
|
||||
{lit, _, {bool, true}} ->
|
||||
Call = aeb_fate_ops:call_pgr(?a, Lbl, ArgType, RetType, ?a, ?a, ?i(true)),
|
||||
call_to_scode(Env, Call, [Ct, Value, Gas | Args]);
|
||||
_ ->
|
||||
Call = aeb_fate_ops:call_pgr(?a, Lbl, ArgType, RetType, ?a, ?a, ?a),
|
||||
call_to_scode(Env, Call, [Ct, Value, Gas, Protected | Args])
|
||||
end;
|
||||
end,
|
||||
[ dbg_loc(Env, Ann) | SCode ];
|
||||
|
||||
to_scode1(_Env, {get_state, Reg}) ->
|
||||
[push(?s(Reg))];
|
||||
to_scode1(Env, {set_state, Reg, Val}) ->
|
||||
call_to_scode(Env, [{'STORE', ?s(Reg), ?a},
|
||||
tuple(0)], [Val]);
|
||||
to_scode1(Env, {get_state, Ann, Reg}) ->
|
||||
[ dbg_loc(Env, Ann), push(?s(Reg)) ];
|
||||
to_scode1(Env, {set_state, Ann, Reg, Val}) ->
|
||||
[ dbg_loc(Env, Ann) | call_to_scode(Env, [{'STORE', ?s(Reg), ?a}, tuple(0)], [Val]) ];
|
||||
|
||||
to_scode1(Env, {closure, Fun, FVs}) ->
|
||||
to_scode(Env, {tuple, [{lit, {string, make_function_id(Fun)}}, FVs]});
|
||||
to_scode1(Env, {closure, Ann, Fun, FVs}) ->
|
||||
[ to_scode(Env, {tuple, Ann, [{lit, Ann, {string, make_function_id(Fun)}}, FVs]}) ];
|
||||
|
||||
to_scode1(Env, {switch, Case}) ->
|
||||
split_to_scode(Env, Case).
|
||||
to_scode1(Env, {switch, Ann, Case}) ->
|
||||
[ dbg_loc(Env, Ann) | split_to_scode(Env, Case) ].
|
||||
|
||||
local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun);
|
||||
local_call(_Env, Fun) -> aeb_fate_ops:call(Fun).
|
||||
local_call( Env = #env{debug_info = false}, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun);
|
||||
local_call(_Env, Fun) -> aeb_fate_ops:call(Fun).
|
||||
|
||||
split_to_scode(Env, {nosplit, Expr}) ->
|
||||
[switch_body, to_scode(Env, Expr)];
|
||||
split_to_scode(Env, {nosplit, Renames, Expr}) ->
|
||||
[switch_body, dbg_scoped_vars(Env, Renames, to_scode(Env, Expr))];
|
||||
split_to_scode(Env, {split, {tuple, _}, X, Alts}) ->
|
||||
{Def, Alts1} = catchall_to_scode(Env, X, Alts),
|
||||
Arg = lookup_var(Env, X),
|
||||
@@ -649,7 +634,7 @@ builtin_to_scode(Env, chain_bytecode_hash, [_Addr] = Args) ->
|
||||
builtin_to_scode(Env, chain_clone,
|
||||
[InitArgsT, GasCap, Value, Prot, Contract | InitArgs]) ->
|
||||
case GasCap of
|
||||
{builtin, call_gas_left, _} ->
|
||||
{builtin, _, call_gas_left, _} ->
|
||||
call_to_scode(Env, aeb_fate_ops:clone(?a, ?a, ?a, ?a),
|
||||
[Contract, InitArgsT, Value, Prot | InitArgs]
|
||||
);
|
||||
@@ -751,6 +736,77 @@ push(A) -> {'STORE', ?a, A}.
|
||||
tuple(0) -> push(?i({tuple, {}}));
|
||||
tuple(N) -> aeb_fate_ops:tuple(?a, N).
|
||||
|
||||
%% -- Debug info functions --
|
||||
|
||||
dbg_contract(#env{debug_info = false}) ->
|
||||
[];
|
||||
dbg_contract(#env{contract = Contract}) ->
|
||||
[{'DBG_CONTRACT', {immediate, Contract}}].
|
||||
|
||||
dbg_loc(#env{debug_info = false}, _) ->
|
||||
[];
|
||||
dbg_loc(_Env, Ann) ->
|
||||
File = case proplists:get_value(file, Ann, no_file) of
|
||||
no_file -> "";
|
||||
F -> F
|
||||
end,
|
||||
Line = proplists:get_value(line, Ann, undefined),
|
||||
case Line of
|
||||
undefined -> [];
|
||||
_ -> [{'DBG_LOC', {immediate, File}, {immediate, Line}}]
|
||||
end.
|
||||
|
||||
dbg_scoped_vars(#env{debug_info = false}, _, SCode) ->
|
||||
SCode;
|
||||
dbg_scoped_vars(_Env, [], SCode) ->
|
||||
SCode;
|
||||
dbg_scoped_vars(Env, [{SavedVarName, Var} | Rest], SCode) ->
|
||||
dbg_scoped_vars(Env, Rest, dbg_scoped_var(Env, SavedVarName, Var, SCode));
|
||||
dbg_scoped_vars(Env = #env{saved_fresh_names = SavedFreshNames}, [Var | Rest], SCode) ->
|
||||
SavedVarName = maps:get(Var, SavedFreshNames, Var),
|
||||
dbg_scoped_vars(Env, Rest, dbg_scoped_var(Env, SavedVarName, Var, SCode)).
|
||||
|
||||
dbg_scoped_var(Env, SavedVarName, Var, SCode) ->
|
||||
case SavedVarName == "_" orelse is_fresh_name(SavedVarName) of
|
||||
true ->
|
||||
SCode;
|
||||
false ->
|
||||
Register = lookup_var(Env, Var),
|
||||
Def = [{'DBG_DEF', {immediate, SavedVarName}, Register}],
|
||||
Undef = [{'DBG_UNDEF', {immediate, SavedVarName}, Register}],
|
||||
Def ++ dbg_undef(Undef, SCode)
|
||||
end.
|
||||
|
||||
is_fresh_name([$% | _]) ->
|
||||
true;
|
||||
is_fresh_name(_) ->
|
||||
false.
|
||||
|
||||
dbg_undef(_Undef, missing) ->
|
||||
missing;
|
||||
dbg_undef(Undef, loop) ->
|
||||
[Undef, loop];
|
||||
dbg_undef(Undef, switch_body) ->
|
||||
[switch_body, Undef];
|
||||
dbg_undef(Undef, {switch, Arg, Type, Alts, Catch}) ->
|
||||
NewAlts = [ dbg_undef(Undef, Alt) || Alt <- Alts ],
|
||||
NewCatch = dbg_undef(Undef, Catch),
|
||||
NewSwitch = {switch, Arg, Type, NewAlts, NewCatch},
|
||||
NewSwitch;
|
||||
dbg_undef(Undef, SCode) when is_list(SCode) ->
|
||||
lists:droplast(SCode) ++ [dbg_undef(Undef, lists:last(SCode))];
|
||||
dbg_undef(Undef, SCode) when is_tuple(SCode); is_atom(SCode) ->
|
||||
[Mnemonic | _] =
|
||||
case is_tuple(SCode) of
|
||||
true -> tuple_to_list(SCode);
|
||||
false -> [SCode]
|
||||
end,
|
||||
Op = aeb_fate_opcodes:m_to_op(Mnemonic),
|
||||
case aeb_fate_opcodes:end_bb(Op) of
|
||||
true -> [Undef, SCode];
|
||||
false -> [SCode, Undef]
|
||||
end.
|
||||
|
||||
%% -- Phase II ---------------------------------------------------------------
|
||||
%% Optimize
|
||||
|
||||
@@ -886,6 +942,10 @@ attributes(I) ->
|
||||
loop -> Impure(pc, []);
|
||||
switch_body -> Pure(none, []);
|
||||
'RETURN' -> Impure(pc, []);
|
||||
{'DBG_LOC', _, _} -> Impure(none, []);
|
||||
{'DBG_DEF', _, _} -> Impure(none, []);
|
||||
{'DBG_UNDEF', _, _} -> Impure(none, []);
|
||||
{'DBG_CONTRACT', _} -> Impure(none, []);
|
||||
{'RETURNR', A} -> Impure(pc, A);
|
||||
{'CALL', A} -> Impure(?a, [A]);
|
||||
{'CALL_R', A, _, B, C, D} -> Impure(?a, [A, B, C, D]);
|
||||
@@ -1605,7 +1665,23 @@ bb(_Name, Code) ->
|
||||
Blocks = lists:flatmap(fun split_calls/1, Blocks1),
|
||||
Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]),
|
||||
BBs = [ set_labels(Labels, B) || B <- Blocks ],
|
||||
maps:from_list(BBs).
|
||||
maps:from_list(dbg_loc_filter(BBs)).
|
||||
|
||||
%% Filter DBG_LOC instructions to keep one instruction per line
|
||||
dbg_loc_filter(BBs) ->
|
||||
dbg_loc_filter(BBs, [], [], sets:new()).
|
||||
|
||||
dbg_loc_filter([], _, AllBlocks, _) ->
|
||||
lists:reverse(AllBlocks);
|
||||
dbg_loc_filter([{I, []} | Rest], AllOps, AllBlocks, DbgLocs) ->
|
||||
dbg_loc_filter(Rest, [], [{I, lists:reverse(AllOps)} | AllBlocks], DbgLocs);
|
||||
dbg_loc_filter([{I, [Op = {'DBG_LOC', _, _} | Ops]} | Rest], AllOps, AllBlocks, DbgLocs) ->
|
||||
case sets:is_element(Op, DbgLocs) of
|
||||
true -> dbg_loc_filter([{I, Ops} | Rest], AllOps, AllBlocks, DbgLocs);
|
||||
false -> dbg_loc_filter([{I, Ops} | Rest], [Op | AllOps], AllBlocks, sets:add_element(Op, DbgLocs))
|
||||
end;
|
||||
dbg_loc_filter([{I, [Op | Ops]} | Rest], AllOps, AllBlocks, DbgLocs) ->
|
||||
dbg_loc_filter([{I, Ops} | Rest], [Op | AllOps], AllBlocks, DbgLocs).
|
||||
|
||||
%% -- Break up scode into basic blocks --
|
||||
|
||||
|
||||
+3
-2
@@ -10,7 +10,7 @@
|
||||
|
||||
-export([get_ann/1, get_ann/2, get_ann/3, set_ann/2, qualify/2]).
|
||||
|
||||
-export_type([ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
|
||||
-export_type([ann_file/0, ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
|
||||
-export_type([name/0, id/0, con/0, qid/0, qcon/0, tvar/0, op/0]).
|
||||
-export_type([bin_op/0, un_op/0]).
|
||||
-export_type([decl/0, letbind/0, typedef/0, pragma/0, fundecl/0]).
|
||||
@@ -24,8 +24,9 @@
|
||||
-type ann_col() :: integer().
|
||||
-type ann_origin() :: system | user.
|
||||
-type ann_format() :: '?:' | hex | infix | prefix | elif.
|
||||
-type ann_file() :: string() | no_file.
|
||||
|
||||
-type ann() :: [ {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()}
|
||||
-type ann() :: [ {file, ann_file()} | {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()}
|
||||
| stateful | private | payable | main | interface | entrypoint].
|
||||
|
||||
-type name() :: string().
|
||||
|
||||
@@ -1,17 +0,0 @@
|
||||
-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)}.
|
||||
@@ -1,593 +0,0 @@
|
||||
-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}).
|
||||
@@ -1,138 +0,0 @@
|
||||
-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).
|
||||
@@ -1,941 +0,0 @@
|
||||
-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.
|
||||
@@ -1,499 +0,0 @@
|
||||
-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.
|
||||
@@ -1,102 +0,0 @@
|
||||
-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.
|
||||
@@ -1,39 +0,0 @@
|
||||
-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).
|
||||
@@ -1,48 +0,0 @@
|
||||
-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.
|
||||
@@ -1,248 +0,0 @@
|
||||
-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]).
|
||||
@@ -1,134 +0,0 @@
|
||||
-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.
|
||||
@@ -1,91 +0,0 @@
|
||||
-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}.
|
||||
@@ -1,20 +0,0 @@
|
||||
-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()}.
|
||||
@@ -1,190 +0,0 @@
|
||||
-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.
|
||||
@@ -1,231 +0,0 @@
|
||||
-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,6 +1,6 @@
|
||||
{application, aesophia,
|
||||
[{description, "Compiler for Aeternity Sophia language"},
|
||||
{vsn, "7.1.0"},
|
||||
{vsn, "7.2.0"},
|
||||
{registered, []},
|
||||
{applications,
|
||||
[kernel,
|
||||
|
||||
Reference in New Issue
Block a user