Compare commits

...

14 Commits

Author SHA1 Message Date
Hans Svensson 33229c3513 Prepare release v7.4.0 (#487) 2023-09-05 10:04:46 +02:00
Radosław Rowicki 002e55d529 Name lambdas by their locations (#486)
* Name lambdas by their locations

* changelog
2023-09-04 18:50:37 +02:00
Hans Svensson 9b518150c3 Fix typo in CHANGELOG 2023-08-24 13:00:42 +02:00
Hans Svensson 67948513d5 Prepare v7.3.0 (#484) 2023-08-24 10:59:42 +02:00
Hans Svensson 08fa372c24 Improve independence analysis in code optimizer (#483)
* Improve independence analysis

* Changelog updated
2023-08-24 09:43:40 +02:00
Hans Svensson 3b0ca28c8e Improve constraint solving (#480)
* Clean up constraint solving a bit

* Make unify always return true or false

* Remove unused unify_throws field from Env

* Better structure for constraint solving

* Fix formatting of if_branches error

* More cleanup
2023-08-23 09:43:49 +02:00
Gaith Hallak 86d7b36ba7 Unify typesigs when implementing interface funs (#469) 2023-07-17 13:32:11 +03:00
Gaith Hallak 43c8328615 Prepare v7.2.1 release (#466) 2023-06-29 15:46:23 +04:00
Gaith Hallak c15d411660 Fix bugs caused by the addition of debugging symbols (#464)
* Fix get_catchalls bug

* Fix for event datatype
2023-06-28 18:43:41 +04:00
Gaith Hallak b902226c26 Prepare v7.2.0 release (#462) 2023-06-19 13:21:44 +03:00
Hans Svensson c1e8195fd8 Document Chain.spend and sort Chain functions (#460)
* Document Chain.spend and sort Chain functions

* Too little coffee, re-adding gas-limit
2023-06-19 11:49:03 +02:00
Hans Svensson d5ff9d4a2f fix AENS.update stdlib doc (#459) 2023-06-15 22:45:39 +02:00
Gaith Hallak c395849684 Introduce debugging symbols (#424)
* Add fann type and to_fann fun

* Add fann() to funcall

* Add fann() to closure

* Add fann() to set_state

* Add fann() to remote_u

* Add fann() to remote

* Add fann() to proj

* Add fann() to set_proj

* Add fann() to def and def_u

* Add fann() to op

* Add fann() to let

* Add fann() to lam

* Add fann() to builtin_u

* Add missing functions specs

* Dead code removal

* Fix the spec for compute_state_layout

* Add fann() to var

* Add fann() to switch

* Add fann() to lit and get_state

* Add fann() to builtin

* Add fann() to con

* Add fann() to tuple

* Add fann() to nil

* Fix missing fann() in tuple fexpr()

* Add dbgloc instruction to fate

* Add instructions lines to the debugging result

* Fix compiler tests

* Fix calldata tests

* Rname Ann to FAnn when the type is fann()

* Add line to fann()

* Change attributes for DBGLOC instruction

* Add file to fann()

* Add file to aeso_syntax:ann()

* Fix dialyzer warning

* Remove fann() from fsplit_pat() and fpat()

* Fill out empty fann() when possible

* Save debug locations for child contracts

* Include DBGLOC instructions in the compiler output

* Return an empty string instead of no_file atom

* Wrap args of DBGLOC in immediate tuple

* Upgrade aebytecode ref in rebar.config

* Add DBG_DEF and DBG_UNDEF

* Do not DBG_DEF vars with % prefix

* Do not use DBG_DEF and DBG_UNDEF on args

* Fix dbg_undef for args

* Rename DBGLOC to DBG_LOC

* Remove column from DBG_LOC

* Add missing dbg_loc in to_scode1

* Keep a single DBG_LOC instruction per line

* Remove col from fann

* Add DBG_LOC op to step at function sig

* Remove the variable-register map from debug output

* Use get_value/3 to handle default

* Use lookup instead of lookup_all

* List only needed attributes

* Make debug ops impure

* Split complicated code and add comment

* Fix annotations

* Fix indenting

* Remove dbg_loc before closure

* Add dbg_loc in to_scode

* Add DBG_CALL and DBG_RETURN

* Separate the split at CALL_T and loop

* Revert "Separate the split at CALL_T and loop"

This reverts commit 4ea823a7ca798c756b20cee32f928f41092c4959.

* Revert "Add DBG_CALL and DBG_RETURN"

This reverts commit c406c6feb09b6a5bb859c38d634f08208c901e5a.

* Disable tail call optimization for better debug call stack

* Rename env.debug to env.debug_info

* Upgrade aebytecode: Add DBG_CONTRACT

* Add DBG_CONTRACT instruction

* Check if a var name is fresh in separate function

* Add DBG_CONTRACT and DBG_LOC before DBG_DEF

* Save fresh names of pattern variables

* Implement fsplit_pat_vars for assign

* Set fann for switches

* Revert "Save fresh names of pattern variables"

This reverts commit d2473f982996336131477df2b2115c04a55a62cb.

* Add DBG_DEF for switch pattern vars

* Fix the inability to pattern match constructors

* Upgrade aebytecode dep

* Upgrade aebytecode dep

* Update the lock file

* Add annotations to fexpr var

* Fix issues with pretty-printing of fexprs

* Use FAnn instead of get_fann(Body)

* Upgrade aebytecode version

* Fix pp_fpat

* Fix pattern matching on fpat

* Update rename when a new rename comes up

* Upgrade aebytecode

* Remove the getopt dep

* Fix calldata tests

* Remove file committed by mistake

* Remove location anns from contract call type
2023-06-13 14:36:48 +03:00
Hans Svensson 7bac15949c Introduce encode/decode_value to compiler (#457) 2023-06-01 13:23:21 +02:00
12 changed files with 1275 additions and 915 deletions
+29 -2
View File
@@ -6,6 +6,28 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
## [Unreleased]
### Added
### Changed
### Removed
### Fixed
## [7.4.0]
### Changed
- Names of lifted lambdas now consist of parent function's name and their
position in the source code.
### Fixed
- Lifted lambdas get their names assigned deterministically.
## [7.3.0]
### Fixed
- Fixed a bug with polymorphism that allowed functions with the same name but different type to be considered as implementations for their corresponding interface function.
- Fixed a bug in the byte code optimization that incorrectly reordered dependent instructions.
## [7.2.1]
### Fixed
- Fixed bugs with the newly added debugging symbols
## [7.2.0]
### Added
- Toplevel compile-time constants
```
namespace N =
@@ -13,8 +35,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 +411,11 @@ 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.4.0...HEAD
[7.4.0]: https://github.com/aeternity/aesophia/compare/v7.3.0...v7.4.0
[7.3.0]: https://github.com/aeternity/aesophia/compare/v7.2.1...v7.3.0
[7.2.1]: https://github.com/aeternity/aesophia/compare/v7.2.0...v7.2.1
[7.2.0]: https://github.com/aeternity/aesophia/compare/v7.1.0...v7.2.0
[7.1.0]: https://github.com/aeternity/aesophia/compare/v7.0.1...v7.1.0
[7.0.1]: https://github.com/aeternity/aesophia/compare/v7.0.0...v7.0.1
[7.0.0]: https://github.com/aeternity/aesophia/compare/v6.1.0...v7.0.0
-2
View File
@@ -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
View File
@@ -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
View File
@@ -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.4.0"},
[aesophia, aebytecode, getopt]},
{dev_mode, true},
+3 -3
View File
@@ -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"}},
+166 -185
View File
@@ -154,7 +154,6 @@
, 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
@@ -351,11 +350,11 @@ bind_contract(Typing, {Contract, Ann, Id, _Impls, Contents}, Env)
Sys = [{origin, system}],
TypeOrFresh = fun({typed, _, _, Type}) -> Type; (_) -> fresh_uvar(Sys) end,
Fields =
[ {field_t, AnnF, Entrypoint, contract_call_type(Type)}
[ {field_t, AnnF, Entrypoint, contract_call_type(aeso_syntax:set_ann(Sys, Type))}
|| {fun_decl, AnnF, Entrypoint, Type = {fun_t, _, _, _, _}} <- Contents ] ++
[ {field_t, AnnF, Entrypoint,
contract_call_type(
{fun_t, AnnF, [], [TypeOrFresh(Arg) || Arg <- Args], TypeOrFresh(Ret)})
{fun_t, Sys, [], [TypeOrFresh(Arg) || Arg <- Args], TypeOrFresh(Ret)})
}
|| {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, [{guarded, _, [], Ret}]} <- Contents,
Name =/= "init"
@@ -1582,7 +1581,7 @@ check_reserved_entrypoints(Funs) ->
check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type = {fun_t, _, _, _, _}}) ->
Type1 = {fun_t, _, Named, Args, Ret} = check_type(Env, Type),
TypeSig = {type_sig, Ann, none, Named, Args, Ret},
register_implementation(Id, TypeSig),
register_implementation(Env, Id, TypeSig),
{{Name, TypeSig}, {fun_decl, Ann, Id, Type1}};
check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) ->
type_error({fundecl_must_have_funtype, Ann, Id, Type}),
@@ -1590,13 +1589,16 @@ check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) ->
%% Register the function FunId as implemented by deleting it from the functions
%% to be implemented table if it is included there, or return true otherwise.
-spec register_implementation(FunId, FunSig) -> true | no_return() when
-spec register_implementation(env(), FunId, FunSig) -> true | no_return() when
FunId :: aeso_syntax:id(),
FunSig :: typesig().
register_implementation(Id, Sig) ->
register_implementation(Env, Id, Sig) ->
Name = name(Id),
case ets_lookup(functions_to_implement, Name) of
[{Name, Interface, Decl = {fun_decl, _, DeclId, _}}] ->
[{Name, Interface, Decl = {fun_decl, _, DeclId, FunT}}] ->
When = {implement_interface_fun, aeso_syntax:get_ann(Sig), Name, name(Interface)},
unify(Env, typesig_to_fun_t(Sig), FunT, When),
DeclStateful = aeso_syntax:get_ann(stateful, Decl, false),
DeclPayable = aeso_syntax:get_ann(payable, Decl, false),
@@ -1624,7 +1626,7 @@ infer_nonrec(Env, LetFun) ->
create_constraints(),
NewLetFun = {{_, Sig}, _} = infer_letfun(Env, LetFun),
check_special_funs(Env, NewLetFun),
register_implementation(get_letfun_id(LetFun), Sig),
register_implementation(Env, get_letfun_id(LetFun), Sig),
solve_then_destroy_and_report_unsolved_constraints(Env),
Result = {TypeSig, _} = instantiate(NewLetFun),
print_typesig(TypeSig),
@@ -1654,11 +1656,11 @@ infer_letrec(Env, Defs) ->
Inferred =
[ begin
Res = {{Name, TypeSig}, LetFun} = infer_letfun(ExtendEnv, LF),
register_implementation(get_letfun_id(LetFun), TypeSig),
register_implementation(Env, get_letfun_id(LetFun), TypeSig),
Got = proplists:get_value(Name, Funs),
Expect = typesig_to_fun_t(TypeSig),
unify(Env, Got, Expect, {check_typesig, Name, Got, Expect}),
solve_constraints(Env),
solve_all_constraints(Env),
?PRINT_TYPES("Checked ~s : ~s\n",
[Name, pp(dereference_deep(Got))]),
Res
@@ -2573,61 +2575,118 @@ get_constraints() ->
destroy_constraints() ->
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 = fun_arity(dereference_deep(FieldType)),
FieldInfos = case Arity of
none -> lookup_record_field(Env, FieldName, Kind);
_ -> lookup_record_field_arity(Env, FieldName, Arity, Kind)
end,
case FieldInfos of
[] ->
type_error({undefined_field, Field}),
false;
[#field_info{field_t = FldType, record_t = RecType}] ->
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()),
%% Solve all constraints by iterating until no-progress
% The two passes on AmbiguousConstraints are needed
solve_ambiguous_constraints(Env, AmbiguousConstraints ++ AmbiguousConstraints).
-spec solve_all_constraints(env()) -> ok.
solve_all_constraints(Env) ->
Constraints = [C || C <- get_constraints(), not one_shot_field_constraint(Env, C) ],
solve_constraints_top(Env, Constraints).
-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);
solve_constraints_top(Env, Constraints) ->
UnsolvedCs = solve_constraints(Env, Constraints),
Progress = solve_unknown_record_constraints(Env, UnsolvedCs),
if length(UnsolvedCs) < length(Constraints) orelse Progress == true ->
solve_constraints_top(Env, UnsolvedCs);
true ->
case solve_unknown_record_types(Env, Unknown) of
true -> %% Progress!
solve_ambiguous_constraints(Env, Unknown);
_ -> ok %% No progress. Report errors later.
end
ok
end.
-spec solve_constraints(env(), [constraint()]) -> [constraint()].
solve_constraints(Env, Constraints) ->
[ C1 || C <- Constraints, C1 <- [dereference_deep(C)], not solve_constraint(Env, C1) ].
solve_unknown_record_constraints(Env, Constraints) ->
FieldCs = lists:filter(fun(#field_constraint{record_t = {uvar, _, _}}) -> true; (_) -> false end, Constraints),
FieldCsUVars = lists:usort([UVar || #field_constraint{record_t = UVar = {uvar, _, _}} <- FieldCs]),
FieldConstraint = fun(#field_constraint{ field = F, kind = K, context = Ctx }) -> {K, Ctx, F} end,
FieldsForUVar = fun(UVar) ->
[ FieldConstraint(FC) || FC = #field_constraint{record_t = U} <- FieldCs, U == UVar ]
end,
Solutions = [ solve_for_uvar(Env, UVar, FieldsForUVar(UVar)) || UVar <- FieldCsUVars ],
case lists:member(true, Solutions) of
true -> true;
false -> Solutions
end.
%% -- Simple constraints --
%% Returns true if solved (unified or type error)
solve_constraint(_Env, #field_constraint{record_t = {uvar, _, _}}) ->
false;
solve_constraint(Env, #field_constraint{record_t = RecordType,
field = Field = {id, _As, FieldName},
field_t = FieldType,
context = When}) ->
RecId = record_type_name(RecordType),
Attrs = aeso_syntax:get_ann(RecId),
case 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],
case proplists:get_value(FieldName, FieldTypes) of
undefined ->
type_error({missing_field, Field, RecId});
FldType ->
solve_field_constraint(Env, FieldType, FldType, RecordType, app_t(Attrs, RecId, Formals), When)
end;
_ ->
type_error({not_a_record_type, instantiate(RecordType), When})
end,
true;
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, _}) -> false;
solve_constraint(Env, {add_bytes, Ann, _, A0, B0, C0}) ->
A = unfold_types_in_type(Env, dereference(A0)),
B = unfold_types_in_type(Env, dereference(B0)),
C = unfold_types_in_type(Env, 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});
_ -> false
end;
solve_constraint(_, _) -> false.
one_shot_field_constraint(Env, #field_constraint{record_t = RecordType,
field = Field = {id, _As, FieldName},
field_t = FieldType,
kind = Kind,
context = When}) ->
Arity = fun_arity(dereference_deep(FieldType)),
FieldInfos = case Arity of
none -> lookup_record_field(Env, FieldName, Kind);
_ -> lookup_record_field_arity(Env, FieldName, Arity, Kind)
end,
case FieldInfos of
[] ->
type_error({undefined_field, Field}),
true;
[#field_info{field_t = FldType, record_t = RecType}] ->
solve_field_constraint(Env, FieldType, FldType, RecordType, RecType, When),
true;
_ ->
false
end;
one_shot_field_constraint(_Env, _Constraint) ->
false.
solve_field_constraint(Env, FieldType, FldType, RecordType, RecType, When) ->
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}).
solve_then_destroy_and_report_unsolved_constraints(Env) ->
solve_constraints(Env),
solve_all_constraints(Env),
destroy_and_report_unsolved_constraints(Env).
destroy_and_report_unsolved_constraints(Env) ->
@@ -2658,21 +2717,10 @@ destroy_and_report_unsolved_constraints(Env) ->
(_) -> false
end, OtherCs5),
Unsolved = [ S || S <- [ solve_constraint(Env, dereference_deep(C)) || C <- NamedArgCs ],
S == unsolved ],
[ type_error({unsolved_named_argument_constraint, C}) || C <- 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_field_constraints(Env, FieldCs),
check_record_create_constraints(Env, CreateCs),
check_is_contract_constraints(Env, ContractCs),
check_named_args_constraints(Env, NamedArgCs),
check_bytes_constraints(Env, BytesCs),
check_aens_resolve_constraints(Env, AensResolveCs),
check_oracle_type_constraints(Env, OracleTypeCs),
@@ -2690,20 +2738,21 @@ get_oracle_type(_Fun, _Args, _Ret) -> false.
%% -- Named argument 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.
%% True if solved (unified or type error), false otherwise
-spec check_named_argument_constraint(env(), named_argument_constraint()) -> true | false.
check_named_argument_constraint(_Env, #named_argument_constraint{ args = {uvar, _, _} }) ->
unsolved;
false;
check_named_argument_constraint(Env,
C = #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, C}), true
end;
type_error({bad_named_argument, Args, Id});
[T] ->
unify(Env, T, Type, {check_named_arg_constraint, C})
end,
true;
check_named_argument_constraint(Env,
#dependent_type_constraint{ named_args_t = NamedArgsT0,
named_args = NamedArgs,
@@ -2720,10 +2769,11 @@ check_named_argument_constraint(Env,
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.
unify(Env, GenType1, SpecType, {check_expr, App, GenType1, SpecType});
_ ->
unify(Env, GenType, SpecType, {check_expr, App, GenType, SpecType})
end,
true.
specialize_dependent_type(Env, Type) ->
case dereference(Type) of
@@ -2739,53 +2789,16 @@ specialize_dependent_type(Env, Type) ->
_ -> Type %% Currently no deep dependent types
end.
%% -- Bytes constraints --
check_field_constraints(Env, Constraints) ->
UnsolvedFieldCs = solve_constraints(Env, Constraints),
case solve_unknown_record_constraints(Env, UnsolvedFieldCs) of
true -> ok;
Errors -> [ type_error(Err) || Err <- Errors ]
end.
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 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, 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, dereference(A0)),
B = unfold_types_in_type(Env, dereference(B0)),
C = unfold_types_in_type(Env, 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_named_args_constraints(Env, Constraints) ->
UnsolvedNamedArgCs = solve_constraints(Env, Constraints),
[ type_error({unsolved_named_argument_constraint, C}) || C <- UnsolvedNamedArgCs ].
check_bytes_constraints(Env, Constraints) ->
InAddConstraint = [ T || {add_bytes, _, _, A, B, C} <- Constraints,
@@ -2882,30 +2895,6 @@ check_is_contract_constraints(Env, [C | Cs]) ->
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 = dereference(RecordType)};
(C) -> dereference_deep(C)
end, Constraints),
SolvedConstraints = lists:map(fun(C) -> solve_constraint(Env, 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) ->
@@ -3084,16 +3073,12 @@ unify0(Env, A, B, 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) ->
type_error({unify_varargs, When}),
false;
unify1(_Env, {uvar, A, R}, T, _Variance, When) ->
case occurs_check(R, T) of
true ->
if
Env#env.unify_throws ->
cannot_unify({uvar, A, R}, T, none, When);
true ->
ok
end,
cannot_unify({uvar, A, R}, T, none, When),
false;
false ->
ets_insert(type_vars, {R, T}),
@@ -3120,18 +3105,13 @@ unify1(Env, A = {con, _, NameA}, B = {con, _, NameB}, Variance, When) ->
case is_subtype(Env, NameA, NameB, Variance) of
true -> true;
false ->
if
Env#env.unify_throws ->
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);
true ->
ok
end,
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
end;
unify1(_Env, {qid, _, Name}, {qid, _, Name}, _Variance, _When) ->
@@ -3145,9 +3125,11 @@ unify1(Env, {if_t, _, {id, _, Id}, Then1, Else1}, {if_t, _, {id, _, Id}, Then2,
unify0(Env, Else1, Else2, Variance, When);
unify1(_Env, {fun_t, _, _, _, _}, {fun_t, _, _, var_args, _}, _Variance, When) ->
type_error({unify_varargs, When});
type_error({unify_varargs, When}),
false;
unify1(_Env, {fun_t, _, _, var_args, _}, {fun_t, _, _, _, _}, _Variance, When) ->
type_error({unify_varargs, When});
type_error({unify_varargs, When}),
false;
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
@@ -3169,7 +3151,7 @@ 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, Id1, Id2, Variance, {arg_name, Id1, Id2, When}) andalso
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
@@ -3178,13 +3160,8 @@ 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) ->
if
Env#env.unify_throws ->
cannot_unify(A, B, none, When);
true ->
ok
end,
unify1(_Env, A, B, _Variance, When) ->
cannot_unify(A, B, none, When),
false.
is_subtype(_Env, NameA, NameB, invariant) ->
@@ -4117,8 +4094,8 @@ pp_when({if_branches, Then, ThenType0, Else, 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 ] ])};
"~s", [string:join([ io_lib:format("~s (at ~s)", [pp_typed(" - ", B, BType), pp_loc(B)])
|| {B, BType} <- Branches ], "\n")])};
pp_when({case_pat, Pat, PatType0, ExprType0}) ->
{PatType, ExprType} = instantiate({PatType0, ExprType0}),
{pos(Pat),
@@ -4165,6 +4142,10 @@ pp_when({var_args, Ann, Fun}) ->
{pos(Ann)
, io_lib:format("when resolving arguments of variadic function `~s`", [pp_expr(Fun)])
};
pp_when({implement_interface_fun, Ann, Entrypoint, Interface}) ->
{ pos(Ann)
, io_lib:format("when implementing the entrypoint `~s` from the interface `~s`", [Entrypoint, Interface])
};
pp_when(unknown) -> {pos(0,0), ""}.
-spec pp_why_record(why_record()) -> {pos(), iolist()}.
+741 -523
View File
File diff suppressed because it is too large Load Diff
+74 -33
View File
@@ -12,6 +12,8 @@
, file/2
, from_string/2
, check_call/4
, decode_value/4
, encode_value/4
, create_calldata/3
, create_calldata/4
, version/0
@@ -117,7 +119,7 @@ from_string1(ContractString, Options) ->
, warnings := Warnings } = string_to_code(ContractString, Options),
#{ child_con_env := ChildContracts } = FCodeEnv,
SavedFreshNames = maps:get(saved_fresh_names, FCodeEnv, #{}),
{FateCode, VarsRegs} = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
FateCode = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
pp_assembler(FateCode, Options),
ByteCode = aeb_fate_code:serialize(FateCode, []),
{ok, Version} = version(),
@@ -130,13 +132,7 @@ from_string1(ContractString, Options) ->
payable => maps:get(payable, FCode),
warnings => Warnings
},
ResDbg = Res#{variables_registers => VarsRegs},
FinalRes =
case proplists:get_value(debug_info, Options, false) of
true -> ResDbg;
false -> Res
end,
{ok, maybe_generate_aci(FinalRes, FoldedTypedAst, Options)}.
{ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}.
maybe_generate_aci(Result, FoldedTypedAst, Options) ->
case proplists:get_value(aci, Options) of
@@ -188,30 +184,55 @@ check_call(Source, FunName, Args, Options) ->
check_call1(Source, FunName, Args, Options).
check_call1(ContractString0, FunName, Args, Options) ->
case add_extra_call(ContractString0, {call, FunName, Args}, Options) of
{ok, CallName, Code} ->
{def, _, _, FcodeArgs} = get_call_body(CallName, Code),
{ok, FunName, [ aeso_fcode_to_fate:term_to_fate(A) || A <- FcodeArgs ]};
Err = {error, _} ->
Err
end.
add_extra_call(Contract0, Call, Options) ->
try
%% First check the contract without the __call function
#{fcode := OrgFcode
, fcode_env := #{child_con_env := ChildContracts}
, ast := Ast} = string_to_code(ContractString0, Options),
{FateCode, _} = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
, ast := Ast} = string_to_code(Contract0, Options),
FateCode = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
%% collect all hashes and compute the first name without hash collision to
SymbolHashes = maps:keys(aeb_fate_code:symbols(FateCode)),
CallName = first_none_match(?CALL_NAME, SymbolHashes,
lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)),
ContractString = insert_call_function(Ast, ContractString0, CallName, FunName, Args),
#{fcode := Fcode} = string_to_code(ContractString, Options),
CallArgs = arguments_of_body(CallName, FunName, Fcode),
{ok, FunName, CallArgs}
Contract = insert_call_function(Ast, Contract0, CallName, Call),
{ok, CallName, string_to_code(Contract, Options)}
catch
throw:{error, Errors} -> {error, Errors}
end.
arguments_of_body(CallName, _FunName, Fcode) ->
get_call_body(CallName, #{fcode := Fcode}) ->
#{body := Body} = maps:get({entrypoint, list_to_binary(CallName)}, maps:get(functions, Fcode)),
{def, _FName, Args} = Body,
%% FName is either {entrypoint, list_to_binary(FunName)} or 'init'
[ aeso_fcode_to_fate:term_to_fate(A) || A <- Args ].
Body.
encode_value(Contract0, Type, Value, Options) ->
case add_extra_call(Contract0, {value, Type, Value}, Options) of
{ok, CallName, Code} ->
Body = get_call_body(CallName, Code),
{ok, aeb_fate_encoding:serialize(aeso_fcode_to_fate:term_to_fate(Body))};
Err = {error, _} ->
Err
end.
decode_value(Contract0, Type, FateValue, Options) ->
case add_extra_call(Contract0, {type, Type}, Options) of
{ok, CallName, Code} ->
#{ unfolded_typed_ast := TypedAst
, type_env := TypeEnv} = Code,
{ok, _, Type0} = get_decode_type(CallName, TypedAst),
Type1 = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
fate_data_to_sophia_value(Type0, Type1, FateValue);
Err = {error, _} ->
Err
end.
first_none_match(_CallName, _Hashes, []) ->
error(unable_to_find_unique_call_name);
@@ -224,14 +245,31 @@ first_none_match(CallName, Hashes, [Char|Chars]) ->
end.
%% Add the __call function to a contract.
-spec insert_call_function(aeso_syntax:ast(), string(), string(), string(), [string()]) -> string().
insert_call_function(Ast, Code, Call, FunName, Args) ->
-spec insert_call_function(aeso_syntax:ast(), string(), string(),
{call, string(), [string()]} | {value, string(), string()} | {type, string()}) -> string().
insert_call_function(Ast, Code, Call, {call, FunName, Args}) ->
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"stateful entrypoint ", Call, "() = ", FunName, "(", string:join(Args, ","), ")\n"
]);
insert_call_function(Ast, Code, Call, {value, Type, Value}) ->
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"entrypoint ", Call, "() : ", Type, " = ", Value, "\n"
]);
insert_call_function(Ast, Code, Call, {type, Type}) ->
Ind = last_contract_indent(Ast),
lists:flatten(
[ Code,
"\n\n",
lists:duplicate(Ind, " "),
"entrypoint ", Call, "(val : ", Type, ") = val\n"
]).
-spec insert_init_function(string(), options()) -> string().
@@ -274,22 +312,25 @@ to_sophia_value(ContractString, FunName, ok, Data, Options0) ->
{ok, _, Type0} = get_decode_type(FunName, TypedAst),
Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
try
{ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))}
catch throw:cannot_translate_to_sophia ->
Type1 = prettypr:format(aeso_pretty:type(Type0)),
Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s",
[aeb_fate_encoding:deserialize(Data), Type1]),
{error, [aeso_errors:new(data_error, Msg)]};
_:_ ->
Type1 = prettypr:format(aeso_pretty:type(Type0)),
Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]),
{error, [aeso_errors:new(data_error, Msg)]}
end
fate_data_to_sophia_value(Type0, Type, Data)
catch
throw:{error, Errors} -> {error, Errors}
end.
fate_data_to_sophia_value(Type, UnfoldedType, FateData) ->
try
{ok, aeso_vm_decode:from_fate(UnfoldedType, aeb_fate_encoding:deserialize(FateData))}
catch throw:cannot_translate_to_sophia ->
Type1 = prettypr:format(aeso_pretty:type(Type)),
Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s",
[aeb_fate_encoding:deserialize(FateData), Type1]),
{error, [aeso_errors:new(data_error, Msg)]};
_:_ ->
Type1 = prettypr:format(aeso_pretty:type(Type)),
Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]),
{error, [aeso_errors:new(data_error, Msg)]}
end.
-spec create_calldata(string(), string(), [string()]) ->
{ok, binary()} | {error, [aeso_errors:error()]}.
create_calldata(Code, Fun, Args) ->
+203 -122
View File
@@ -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]);
@@ -1081,11 +1141,16 @@ independent({i, _, I}, {i, _, J}) ->
StackI = lists:member(?a, [WI | RI]),
StackJ = lists:member(?a, [WJ | RJ]),
if WI == pc; WJ == pc -> false; %% no jumps
not (PureI or PureJ) -> false; %% at least one is pure
StackI and StackJ -> false; %% cannot both use the stack
WI == WJ -> false; %% cannot write to the same register
true ->
ReadStoreI = [] /= [ x || {store, _} <- RI ],
ReadStoreJ = [] /= [ x || {store, _} <- RJ ],
if WI == pc; WJ == pc -> false; %% no jumps
not (PureI or PureJ) -> false; %% at least one is pure
StackI and StackJ -> false; %% cannot both use the stack
WI == WJ -> false; %% cannot write to the same register
ReadStoreI and not PureJ -> false; %% can't read store/state if other is impure
ReadStoreJ and not PureI -> false; %% can't read store/state if other is impure
true ->
%% and cannot write to each other's inputs
not lists:member(WI, RJ) andalso
not lists:member(WJ, RI)
@@ -1605,7 +1670,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
View File
@@ -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 -1
View File
@@ -1,6 +1,6 @@
{application, aesophia,
[{description, "Compiler for Aeternity Sophia language"},
{vsn, "7.1.0"},
{vsn, "7.4.0"},
{registered, []},
{applications,
[kernel,
+7 -5
View File
@@ -871,10 +871,10 @@ failing_contracts() ->
"Trying to implement or extend an undefined interface `Z`">>
])
, ?TYPE_ERROR(polymorphism_contract_interface_same_name_different_type,
[<<?Pos(9,5)
"Duplicate definitions of `f` at\n"
" - line 8, column 5\n"
" - line 9, column 5">>])
[<<?Pos(5,5)
"Cannot unify `char` and `int`\n"
"when implementing the entrypoint `f` from the interface `I1`">>
])
, ?TYPE_ERROR(polymorphism_contract_missing_implementation,
[<<?Pos(4,20)
"Unimplemented entrypoint `f` from the interface `I1` in the contract `I2`">>
@@ -1313,7 +1313,9 @@ validate(Contract1, Contract2) ->
true -> [debug_mode];
false -> []
end ++
[{include, {file_system, [aeso_test_utils:contract_path()]}}]);
[ {src_file, lists:concat([Contract2, ".aes"])}
, {include, {file_system, [aeso_test_utils:contract_path()]}}
]);
Error -> print_and_throw(Error)
end.