QPQ-AG/sophia
10
0
Fork 0
Code Issues 41 Pull Requests 5 Actions Packages Projects Releases 16 Wiki Activity

Merge branch 'master' into radrow-patch-2

Browse Source
This commit is contained in:
Radosław Rowicki 2019-09-02 12:09:53 +02:00 committed by GitHub
commit d14a0025f2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
34 changed files with 869 additions and 630 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
CHANGELOG.md
View File

@ -6,17 +6,41 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
## [Unreleased] ## [Unreleased]
### Added ### Added
- New builtin function `Crypto.ecrecover_secp256k1: (hash, bytes(65)) => bytes(32)`
for recovering Ethereum address from message hash and signature.
- List comprehensions syntax `[x | a <- [1,2,3] ++ l, let x = a + 1, if(x > 1)]`
- Standard library support. `ListInternal` can be included implicitly if list comprehensions are used. - Standard library support. `ListInternal` can be included implicitly if list comprehensions are used.
- Added the `[a..b]` language construct, returning the list of numbers between
`a` and `b` (inclusive). Returns the empty list if `a` > `b`.
### Changed
### Removed
## [4.0.0-rc1] - 2019-08-22
### Added
- FATE backend - the compiler is able to produce VM code for both `AEVM` and `FATE`. Many
of the APIs now take `{backend, aevm | fate}` to decide wich backend to produce artifacts
for.
- New builtin functions `Crypto.ecrecover_secp256k1: (hash, bytes(65)) => option(bytes(20))`
and `Crypto.ecverify_secp256k1 : (hash, bytes(20), bytes(65)) => bool` for recovering
and verifying an Ethereum address for a message hash and a signature.
- Sophia supports list comprehensions known from languages like Python, Haskell or Erlang.
Example syntax:
```
[x + y | x <- [1,2,3,4,5], let k = x*x, if (k > 5), y <- [k, k+1, k+2]]
// yields [12,13,14,20,21,22,30,31,32]
```
- A new contract, and endpoint, modifier `payable` is introduced. Contracts, and enpoints,
that shall be able to receive funds should be marked as payable. `Address.is_payable(a)`
can be used to check if an (contract) address is payable or not.
### Changed ### Changed
- New syntax for tuple types. Now 0-tuple type is encoded as `unit` instead of `()` and - New syntax for tuple types. Now 0-tuple type is encoded as `unit` instead of `()` and
regular tuples are encoded by interspersing inner types with `*`, for instance `int * string`. regular tuples are encoded by interspersing inner types with `*`, for instance `int * string`.
Parens are not necessary. Note it only affects the types, values remain as their were before, Parens are not necessary. Note it only affects the types, values remain as their were before,
so `(1, "a") : int * string` so `(1, "a") : int * string`
- The `AENS.transfer` and `AENS.revoke` functions have been updated to take a name `string`
instead of a name `hash`.
- Fixed a bug where the `AEVM` backend complained about a missing `init` function when
trying to generate calldata from an ACI-generated interface.
- Compiler now returns the ABI-version in the compiler result map.
- Renamed `Crypto.ecverify` and `Crypto.ecverify_secp256k1` into `Crypto.verify_sig` and
`Crypto.verify_sig_secp256k1` respectively.
### Removed ### Removed
## [3.2.0] - 2019-06-28 ## [3.2.0] - 2019-06-28
@ -113,7 +137,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 - Simplify calldata creation - instead of passing a compiled contract, simply
pass a (stubbed) contract string. pass a (stubbed) contract string.
[Unreleased]: https://github.com/aeternity/aesophia/compare/v3.2.0...HEAD [Unreleased]: https://github.com/aeternity/aesophia/compare/v4.0.0-rc1...HEAD
[4.0.0-rc1]: https://github.com/aeternity/aesophia/compare/v3.2.0...v4.0.0-rc1
[3.2.0]: https://github.com/aeternity/aesophia/compare/v3.1.0...v3.2.0 [3.2.0]: https://github.com/aeternity/aesophia/compare/v3.1.0...v3.2.0
[3.1.0]: https://github.com/aeternity/aesophia/compare/v3.0.0...v3.1.0 [3.1.0]: https://github.com/aeternity/aesophia/compare/v3.0.0...v3.1.0
[3.0.0]: https://github.com/aeternity/aesophia/compare/v2.1.0...v3.0.0 [3.0.0]: https://github.com/aeternity/aesophia/compare/v2.1.0...v3.0.0

46
priv/stdlib/Func.aes Normal file
View File

@ -0,0 +1,46 @@
namespace Func =
function id(x : 'a) : 'a = x
function const(x : 'a) : 'b => 'a = (y) => x
function flip(f : ('a, 'b) => 'c) : ('b, 'a) => 'c = (b, a) => f(a, b)
function comp(f : 'b => 'c, g : 'a => 'b) : 'a => 'c = (x) => f(g(x))
function pipe(f : 'a => 'b, g : 'b => 'c) : 'a => 'c = (x) => g(f(x))
function rapply(x : 'a, f : 'a => 'b) : 'b = f(x)
/* The Z combinator - replacement for local and anonymous recursion.
*/
function recur(f : ('arg => 'res, 'arg) => 'res) : 'arg => 'res =
(x) => f(recur(f), x)
function iter(n : int, f : 'a => 'a) : 'a => 'a = iter_(n, f, (x) => x)
private function iter_(n : int, f : 'a => 'a, acc : 'a => 'a) : 'a => 'a =
if(n == 0) acc
elif(n == 1) comp(f, acc)
else iter_(n / 2, comp(f, f), if(n mod 2 == 0) acc else comp(f, acc))
function curry2(f : ('a, 'b) => 'c) : 'a => ('b => 'c) =
(x) => (y) => f(x, y)
function curry3(f : ('a, 'b, 'c) => 'd) : 'a => ('b => ('c => 'd)) =
(x) => (y) => (z) => f(x, y, z)
function uncurry2(f : 'a => ('b => 'c)) : ('a, 'b) => 'c =
(x, y) => f(x)(y)
function uncurry3(f : 'a => ('b => ('c => 'd))) : ('a, 'b, 'c) => 'd =
(x, y, z) => f(x)(y)(z)
function tuplify2(f : ('a, 'b) => 'c) : (('a * 'b)) => 'c =
(t) => switch(t)
(x, y) => f(x, y)
function tuplify3(f : ('a, 'b, 'c) => 'd) : 'a * 'b * 'c => 'd =
(t) => switch(t)
(x, y, z) => f(x, y, z)
function untuplify2(f : 'a * 'b => 'c) : ('a, 'b) => 'c =
(x, y) => f((x, y))
function untuplify3(f : 'a * 'b * 'c => 'd) : ('a, 'b, 'c) => 'd =
(x, y, z) => f((x, y, z))

214
priv/stdlib/List.aes Normal file
View File

@ -0,0 +1,214 @@
include "ListInternal.aes"
namespace List =
function is_empty(l : list('a)) : bool = switch(l)
[] => true
_ => false
function first(l : list('a)) : option('a) = switch(l)
[] => None
h::_ => Some(h)
function tail(l : list('a)) : option(list('a)) = switch(l)
[] => None
_::t => Some(t)
function last(l : list('a)) : option('a) = switch(l)
[] => None
[x] => Some(x)
_::t => last(t)
function find(p : 'a => bool, l : list('a)) : option('a) = switch(l)
[] => None
h::t => if(p(h)) Some(h) else find(p, t)
function find_indices(p : 'a => bool, l : list('a)) : list(int) = find_indices_(p, l, 0, [])
private function find_indices_( p : 'a => bool
, l : list('a)
, n : int
, acc : list(int)
) : list(int) = switch(l)
[] => reverse(acc)
h::t => find_indices_(p, t, n+1, if(p(h)) n::acc else acc)
function nth(n : int, l : list('a)) : option('a) =
switch(l)
[] => None
h::t => if(n == 0) Some(h) else nth(n-1, t)
/* Unsafe version of `nth` */
function get(n : int, l : list('a)) : 'a =
switch(l)
[] => abort(if(n < 0) "Negative index get" else "Out of index get")
h::t => if(n == 0) h else get(n-1, t)
function length(l : list('a)) : int = length_(l, 0)
private function length_(l : list('a), acc : int) : int = switch(l)
[] => acc
_::t => length_(t, acc + 1)
function from_to(a : int, b : int) : list(int) = [a..b]
function from_to_step(a : int, b : int, s : int) : list(int) = from_to_step_(a, b, s, [])
private function from_to_step_(a, b, s, acc) =
if (a > b) reverse(acc) else from_to_step_(a + s, b, s, a :: acc)
/* Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow */
function replace_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else replace_at_(n, e, l, [])
private function replace_at_(n : int, e : 'a, l : list('a), acc : list('a)) : list('a) =
switch(l)
[] => abort("replace_at overflow")
h::t => if (n == 0) reverse(e::acc) ++ t
else replace_at_(n-1, e, t, h::acc)
/* Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow */
function insert_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort("insert_at underflow") else insert_at_(n, e, l, [])
private function insert_at_(n : int, e : 'a, l : list('a), acc : list('a)) : list('a) =
if (n == 0) reverse(e::acc) ++ l
else switch(l)
[] => abort("insert_at overflow")
h::t => insert_at_(n-1, e, t, h::acc)
function insert_by(cmp : (('a, 'a) => bool), x : 'a, l : list('a)) : list('a) =
insert_by_(cmp, x, l, [])
private function insert_by_(cmp : (('a, 'a) => bool), x : 'a, l : list('a), acc : list('a)) : list('a) =
switch(l)
[] => reverse(x::acc)
h::t =>
if(cmp(x, h)) // x < h
reverse(acc) ++ (x::l)
else
insert_by_(cmp, x, t, h::acc)
function foldr(cons : ('a, 'b) => 'b, nil : 'b, l : list('a)) : 'b = switch(l)
[] => nil
h::t => cons(h, foldr(cons, nil, t))
function foldl(rcons : ('b, 'a) => 'b, acc : 'b, l : list('a)) : 'b = switch(l)
[] => acc
h::t => foldl(rcons, rcons(acc, h), t)
function foreach(l : list('a), f : 'a => unit) : unit =
switch(l)
[] => ()
e::l' =>
f(e)
foreach(l', f)
function reverse(l : list('a)) : list('a) = foldl((lst, el) => el :: lst, [], l)
function map(f : 'a => 'b, l : list('a)) : list('b) = map_(f, l, [])
private function map_(f : 'a => 'b, l : list('a), acc : list('b)) : list('b) = switch(l)
[] => reverse(acc)
h::t => map_(f, t, f(h)::acc)
function flat_map(f : 'a => list('b), l : list('a)) : list('b) =
ListInternal.flat_map(f, l)
function filter(p : 'a => bool, l : list('a)) : list('a) = filter_(p, l, [])
private function filter_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => filter_(p, t, if(p(h)) h::acc else acc)
/* Take `n` first elements */
function take(n : int, l : list('a)) : list('a) =
if(n < 0) abort("Take negative number of elements") else take_(n, l, [])
private function take_(n : int, l : list('a), acc : list('a)) : list('a) =
if(n == 0) reverse(acc)
else switch(l)
[] => reverse(acc)
h::t => take_(n-1, t, h::acc)
/* Drop `n` first elements */
function drop(n : int, l : list('a)) : list('a) =
if(n < 0) abort("Drop negative number of elements")
elif (n == 0) l
else switch(l)
[] => []
h::t => drop(n-1, t)
/* Get the longest prefix of a list in which every element matches predicate `p` */
function take_while(p : 'a => bool, l : list('a)) : list('a) = take_while_(p, l, [])
private function take_while_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => if(p(h)) take_while_(p, t, h::acc) else reverse(acc)
/* Drop elements from `l` until `p` holds */
function drop_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => if(p(h)) drop_while(p, t) else l
/* Splits list into two lists of elements that respectively match and don't match predicate `p` */
function partition(p : 'a => bool, l : list('a)) : (list('a) * list('a)) = partition_(p, l, [], [])
private function partition_( p : 'a => bool
, l : list('a)
, acc_t : list('a)
, acc_f : list('a)
) : (list('a) * list('a)) = switch(l)
[] => (reverse(acc_t), reverse(acc_f))
h::t => if(p(h)) partition_(p, t, h::acc_t, acc_f) else partition_(p, t, acc_t, h::acc_f)
function flatten(ll : list(list('a))) : list('a) = foldr((l1, l2) => l1 ++ l2, [], ll)
function all(p : 'a => bool, l : list('a)) : bool = switch(l)
[] => true
h::t => if(p(h)) all(p, t) else false
function any(p : 'a => bool, l : list('a)) : bool = switch(l)
[] => false
h::t => if(p(h)) true else any(p, t)
function sum(l : list(int)) : int = foldl ((a, b) => a + b, 0, l)
function product(l : list(int)) : int = foldl((a, b) => a * b, 1, l)
/* Zips two list by applying bimapping function on respective elements. Drops longer tail. */
function zip_with(f : ('a, 'b) => 'c, l1 : list('a), l2 : list('b)) : list('c) = zip_with_(f, l1, l2, [])
private function zip_with_( f : ('a, 'b) => 'c
, l1 : list('a)
, l2 : list('b)
, acc : list('c)
) : list('c) = switch ((l1, l2))
(h1::t1, h2::t2) => zip_with_(f, t1, t2, f(h1, h2)::acc)
_ => reverse(acc)
/* Zips two lists into list of pairs. Drops longer tail. */
function zip(l1 : list('a), l2 : list('b)) : list('a * 'b) = zip_with((a, b) => (a, b), l1, l2)
function unzip(l : list('a * 'b)) : list('a) * list('b) = unzip_(l, [], [])
private function unzip_( l : list('a * 'b)
, acc_l : list('a)
, acc_r : list('b)
) : (list('a) * list('b)) = switch(l)
[] => (reverse(acc_l), reverse(acc_r))
(left, right)::t => unzip_(t, left::acc_l, right::acc_r)
// TODO: Improve?
function sort(lesser_cmp : ('a, 'a) => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => switch (partition((x) => lesser_cmp(x, h), t))
(lesser, bigger) => sort(lesser_cmp, lesser) ++ h::sort(lesser_cmp, bigger)
function intersperse(delim : 'a, l : list('a)) : list('a) = intersperse_(delim, l, [])
private function intersperse_(delim : 'a, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
[e] => reverse(e::acc)
h::t => intersperse_(delim, t, delim::h::acc)
function enumerate(l : list('a)) : list(int * 'a) = enumerate_(l, 0, [])
private function enumerate_(l : list('a), n : int, acc : list(int * 'a)) : list(int * 'a) = switch(l)
[] => reverse(acc)
h::t => enumerate_(t, n + 1, (n, h)::acc)

16
priv/stdlib/ListInternal.aes Normal file
View File

@ -0,0 +1,16 @@
namespace ListInternal =
// -- Flatmap ----------------------------------------------------------------
function flat_map(f : 'a => list('b), xs : list('a)) : list('b) =
switch(xs)
[] => []
x :: xs => f(x) ++ flat_map(f, xs)
// -- From..to ---------------------------------------------------------------
function from_to(a : int, b : int) : list(int) = from_to_(a, b, [])
private function from_to_(a, b, acc) =
if (a > b) acc else from_to_(a, b - 1, b :: acc)

76
priv/stdlib/Option.aes Normal file
View File

@ -0,0 +1,76 @@
include "List.aes"
namespace Option =
function is_none(o : option('a)) : bool = switch(o)
None => true
Some(_) => false
function is_some(o : option('a)) : bool = switch(o)
None => false
Some(_) => true
function match(n : 'b, s : 'a => 'b, o : option('a)) : 'b = switch(o)
None => n
Some(x) => s(x)
function default(def : 'a, o : option('a)) : 'a = match(def, (x) => x, o)
function force(o : option('a)) : 'a = default(abort("Forced None value"), o)
function on_elem(o : option('a), f : 'a => unit) : unit = match((), f, o)
function map(f : 'a => 'b, o : option('a)) : option('b) = switch(o)
None => None
Some(x) => Some(f(x))
function map2(f : ('a, 'b) => 'c
, o1 : option('a)
, o2 : option('b)
) : option('c) = switch((o1, o2))
(Some(x1), Some(x2)) => Some(f(x1, x2))
_ => None
function map3( f : ('a, 'b, 'c) => 'd
, o1 : option('a)
, o2 : option('b)
, o3 : option('c)
) : option('d) = switch((o1, o2, o3))
(Some(x1), Some(x2), Some(x3)) => Some(f(x1, x2, x3))
_ => None
function app_over(f : option ('a => 'b), o : option('a)) : option('b) = switch((f, o))
(Some(ff), Some(xx)) => Some(ff(xx))
_ => None
function flat_map(f : 'a => option('b), o : option('a)) : option('b) = switch(o)
None => None
Some(x) => f(x)
function to_list(o : option('a)) : list('a) = switch(o)
None => []
Some(x) => [x]
function filter_options(l : list(option('a))) : list('a) = filter_options_(l, [])
private function filter_options_(l : list (option('a)), acc : list('a)) : list('a) = switch(l)
[] => List.reverse(acc)
None::t => filter_options_(t, acc)
Some(x)::t => filter_options_(t, x::acc)
function seq_options(l : list (option('a))) : option (list('a)) = seq_options_(l, [])
private function seq_options_(l : list (option('a)), acc : list('a)) : option(list('a)) = switch(l)
[] => Some(List.reverse(acc))
None::t => None
Some(x)::t => seq_options_(t, x::acc)
function choose(o1 : option('a), o2 : option('a)) : option('a) =
if(is_some(o1)) o1 else o2
function choose_first(l : list(option('a))) : option('a) = switch(l)
[] => None
None::t => choose_first(t)
Some(x)::_ => Some(x)

20
priv/stdlib/Pair.aes Normal file
View File

@ -0,0 +1,20 @@
namespace Pair =
function fst(t : ('a * 'b)) : 'a = switch(t)
(x, _) => x
function snd(t : ('a * 'b)) : 'b = switch(t)
(_, y) => y
function map1(f : 'a => 'c, t : ('a * 'b)) : ('c * 'b) = switch(t)
(x, y) => (f(x), y)
function map2(f : 'b => 'c, t : ('a * 'b)) : ('a * 'c) = switch(t)
(x, y) => (x, f(y))
function bimap(f : 'a => 'c, g : 'b => 'd, t : ('a * 'b)) : ('c * 'd) = switch(t)
(x, y) => (f(x), g(y))
function swap(t : ('a * 'b)) : ('b * 'a) = switch(t)
(x, y) => (y, x)

37
priv/stdlib/Triple.aes Normal file
View File

@ -0,0 +1,37 @@
namespace Triple =
function fst(t : ('a * 'b * 'c)) : 'a = switch(t)
(x, _, _) => x
function snd(t : ('a * 'b * 'c)) : 'b = switch(t)
(_, y, _) => y
function thd(t : ('a * 'b * 'c)) : 'c = switch(t)
(_, _, z) => z
function map1(f : 'a => 'm, t : ('a * 'b * 'c)) : ('m * 'b * 'c) = switch(t)
(x, y, z) => (f(x), y, z)
function map2(f : 'b => 'm, t : ('a * 'b * 'c)) : ('a * 'm * 'c) = switch(t)
(x, y, z) => (x, f(y), z)
function map3(f : 'c => 'm, t : ('a * 'b * 'c)) : ('a * 'b * 'm) = switch(t)
(x, y, z) => (x, y, f(z))
function trimap( f : 'a => 'x
, g : 'b => 'y
, h : 'c => 'z
, t : ('a * 'b * 'c)
) : ('x * 'y * 'z) = switch(t)
(x, y, z) => (f(x), g(y), h(z))
function swap(t : ('a * 'b * 'c)) : ('c * 'b * 'a) = switch(t)
(x, y, z) => (z, y, x)
function rotr(t : ('a * 'b * 'c)) : ('c * 'a * 'b) = switch(t)
(x, y, z) => (z, x, y)
function rotl(t : ('a * 'b * 'c)) : ('b * 'c * 'a) = switch(t)
(x, y, z) => (y, z, x)

4
rebar.config
View File

@ -2,7 +2,7 @@
{erl_opts, [debug_info]}. {erl_opts, [debug_info]}.
{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {ref,"10cc127"}}} {deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {ref,"72b2a58"}}}
, {getopt, "1.0.1"} , {getopt, "1.0.1"}
, {eblake2, "1.0.0"} , {eblake2, "1.0.0"}
, {jsx, {git, "https://github.com/talentdeficit/jsx.git", , {jsx, {git, "https://github.com/talentdeficit/jsx.git",
@ -15,7 +15,7 @@
{base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]} {base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
]}. ]}.
{relx, [{release, {aesophia, "3.2.0"}, {relx, [{release, {aesophia, "4.0.0-rc1"},
[aesophia, aebytecode, getopt]}, [aesophia, aebytecode, getopt]},
{dev_mode, true}, {dev_mode, true},

8
rebar.lock
View File

@ -1,17 +1,21 @@
{"1.1.0", {"1.1.0",
[{<<"aebytecode">>, [{<<"aebytecode">>,
{git,"https://github.com/aeternity/aebytecode.git", {git,"https://github.com/aeternity/aebytecode.git",
{ref,"10cc1278831ad7e90138533466ceef4bcafd74a9"}}, {ref,"72b2a581d5a6d488a208331da88de1a488ac2da1"}},
0}, 0},
{<<"aeserialization">>, {<<"aeserialization">>,
{git,"https://github.com/aeternity/aeserialization.git", {git,"https://github.com/aeternity/aeserialization.git",
{ref,"816bf994ffb5cee218c3f22dc5fea296c9e0882e"}}, {ref,"47aaa8f5434b365c50a35bfd1490340b19241991"}},
1}, 1},
{<<"base58">>, {<<"base58">>,
{git,"https://github.com/aeternity/erl-base58.git", {git,"https://github.com/aeternity/erl-base58.git",
{ref,"60a335668a60328a29f9731b67c4a0e9e3d50ab6"}}, {ref,"60a335668a60328a29f9731b67c4a0e9e3d50ab6"}},
2}, 2},
{<<"eblake2">>,{pkg,<<"eblake2">>,<<"1.0.0">>},0}, {<<"eblake2">>,{pkg,<<"eblake2">>,<<"1.0.0">>},0},
{<<"enacl">>,
{git,"https://github.com/aeternity/enacl.git",
{ref,"26180f42c0b3a450905d2efd8bc7fd5fd9cece75"}},
2},
{<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0}, {<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0},
{<<"jsx">>, {<<"jsx">>,
{git,"https://github.com/talentdeficit/jsx.git", {git,"https://github.com/talentdeficit/jsx.git",

14
src/aeso_ast_infer_types.erl
View File

@ -443,7 +443,7 @@ global_env() ->
{ funs = MkDefs( { funs = MkDefs(
[{"resolve", Fun([String, String], option_t(Ann, A))}, [{"resolve", Fun([String, String], option_t(Ann, A))},
{"preclaim", SignFun([Address, Hash], Unit)}, {"preclaim", SignFun([Address, Hash], Unit)},
{"claim", SignFun([Address, String, Int], Unit)}, {"claim", SignFun([Address, String, Int, Int], Unit)},
{"transfer", SignFun([Address, Address, String], Unit)}, {"transfer", SignFun([Address, Address, String], Unit)},
{"revoke", SignFun([Address, String], Unit)}]) }, {"revoke", SignFun([Address, String], Unit)}]) },
@ -767,7 +767,9 @@ check_type(Env, Type = {fun_t, Ann, NamedArgs, Args, Ret}, Arity) ->
{fun_t, Ann, NamedArgs1, Args1, Ret1}; {fun_t, Ann, NamedArgs1, Args1, Ret1};
check_type(_Env, Type = {uvar, _, _}, Arity) -> check_type(_Env, Type = {uvar, _, _}, Arity) ->
ensure_base_type(Type, Arity), ensure_base_type(Type, Arity),
Type. Type;
check_type(_Env, {args_t, Ann, Ts}, _) ->
type_error({new_tuple_syntax, Ann, Ts}).
ensure_base_type(Type, Arity) -> ensure_base_type(Type, Arity) ->
[ type_error({wrong_type_arguments, Type, Arity, 0}) || Arity /= 0 ], [ type_error({wrong_type_arguments, Type, Arity, 0}) || Arity /= 0 ],
@ -1325,7 +1327,7 @@ infer_block(Env, _, [E], BlockType) ->
[check_expr(Env, E, BlockType)]; [check_expr(Env, E, BlockType)];
infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) -> infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) ->
{{Name, TypeSig}, LetFun} = infer_letfun(Env, Def), {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def),
FunT = freshen_type(Ann, typesig_to_fun_t(TypeSig)), FunT = typesig_to_fun_t(TypeSig),
NewE = bind_var({id, Ann, Name}, FunT, Env), NewE = bind_var({id, Ann, Name}, FunT, Env),
[LetFun|infer_block(NewE, Attrs, Rest, BlockType)]; [LetFun|infer_block(NewE, Attrs, Rest, BlockType)];
infer_block(Env, _, [{letval, Attrs, Pattern, Type, E}|Rest], BlockType) -> infer_block(Env, _, [{letval, Attrs, Pattern, Type, E}|Rest], BlockType) ->
@ -1352,6 +1354,9 @@ infer_infix({RelOp, As})
T = fresh_uvar(As), %% allow any type here, check in ast_to_icode that we have comparison for it T = fresh_uvar(As), %% allow any type here, check in ast_to_icode that we have comparison for it
Bool = {id, As, "bool"}, Bool = {id, As, "bool"},
{fun_t, As, [], [T, T], Bool}; {fun_t, As, [], [T, T], Bool};
infer_infix({'..', As}) ->
Int = {id, As, "int"},
{fun_t, As, [], [Int, Int], {app_t, As, {id, As, "list"}, [Int]}};
infer_infix({'::', As}) -> infer_infix({'::', As}) ->
ElemType = fresh_uvar(As), ElemType = fresh_uvar(As),
ListType = {app_t, As, {id, As, "list"}, [ElemType]}, ListType = {app_t, As, {id, As, "list"}, [ElemType]},
@ -2219,6 +2224,9 @@ pp_error({contract_has_no_entrypoints, Con}) ->
"'function'.\n", [pp_expr("", Con), pp_loc(Con)]); "'function'.\n", [pp_expr("", Con), pp_loc(Con)]);
pp_error({unbound_type, Type}) -> pp_error({unbound_type, Type}) ->
io_lib:format("Unbound type ~s (at ~s).\n", [pp_type("", Type), pp_loc(Type)]); io_lib:format("Unbound type ~s (at ~s).\n", [pp_type("", Type), pp_loc(Type)]);
pp_error({new_tuple_syntax, Ann, Ts}) ->
io_lib:format("Invalid type\n~s (at ~s)\nThe syntax of tuple types changed in Sophia version 4.0. Did you mean\n~s\n",
[pp_type(" ", {args_t, Ann, Ts}), pp_loc(Ann), pp_type(" ", {tuple_t, Ann, Ts})]);
pp_error(Err) -> pp_error(Err) ->
io_lib:format("Unknown error: ~p\n", [Err]). io_lib:format("Unknown error: ~p\n", [Err]).

153
src/aeso_ast_to_fcode.erl
View File

@ -185,7 +185,7 @@ builtins() ->
{["Oracle"], [{"register", 4}, {"query_fee", 1}, {"query", 5}, {"get_question", 2}, {["Oracle"], [{"register", 4}, {"query_fee", 1}, {"query", 5}, {"get_question", 2},
{"respond", 4}, {"extend", 3}, {"get_answer", 2}, {"respond", 4}, {"extend", 3}, {"get_answer", 2},
{"check", 1}, {"check_query", 2}]}, {"check", 1}, {"check_query", 2}]},
{["AENS"], [{"resolve", 2}, {"preclaim", 3}, {"claim", 4}, {"transfer", 4}, {["AENS"], [{"resolve", 2}, {"preclaim", 3}, {"claim", 5}, {"transfer", 4},
{"revoke", 3}]}, {"revoke", 3}]},
{["Map"], [{"from_list", 1}, {"to_list", 1}, {"lookup", 2}, {["Map"], [{"from_list", 1}, {"to_list", 1}, {"lookup", 2},
{"lookup_default", 3}, {"delete", 2}, {"member", 2}, {"size", 1}]}, {"lookup_default", 3}, {"delete", 2}, {"member", 2}, {"size", 1}]},
@ -226,6 +226,9 @@ init_type_env() ->
["Chain", "ttl"] => ?type({variant, [[integer], [integer]]}) ["Chain", "ttl"] => ?type({variant, [[integer], [integer]]})
}. }.
is_no_code(Env) ->
proplists:get_value(no_code, maps:get(options, Env, []), false).
%% -- Compilation ------------------------------------------------------------ %% -- Compilation ------------------------------------------------------------
-spec to_fcode(env(), aeso_syntax:ast()) -> fcode(). -spec to_fcode(env(), aeso_syntax:ast()) -> fcode().
@ -244,7 +247,7 @@ to_fcode(Env, [{contract, Attrs, {con, _, Main}, Decls}]) ->
state_type => StateType, state_type => StateType,
event_type => EventType, event_type => EventType,
payable => Payable, payable => Payable,
functions => add_init_function(Env1, functions => add_init_function(Env1, StateType,
add_event_function(Env1, EventType, Funs)) }; add_event_function(Env1, EventType, Funs)) };
to_fcode(Env, [{contract, _, {con, _, Con}, Decls} | Code]) -> to_fcode(Env, [{contract, _, {con, _, Con}, Decls} | Code]) ->
Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Con} }, Decls), Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Con} }, Decls),
@ -268,7 +271,7 @@ decls_to_fcode(Env, Decls) ->
-spec decl_to_fcode(env(), aeso_syntax:decl()) -> env(). -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env().
decl_to_fcode(Env, {type_decl, _, _, _}) -> Env; decl_to_fcode(Env, {type_decl, _, _, _}) -> Env;
decl_to_fcode(Env = #{context := {main_contract, _}}, {fun_decl, Ann, {id, _, Name}, _}) -> decl_to_fcode(Env = #{context := {main_contract, _}}, {fun_decl, Ann, {id, _, Name}, _}) ->
case proplists:get_value(no_code, maps:get(options, Env, []), false) of case is_no_code(Env) of
false -> fcode_error({missing_definition, Name, lists:keydelete(entrypoint, 1, Ann)}); false -> fcode_error({missing_definition, Name, lists:keydelete(entrypoint, 1, Ann)});
true -> Env true -> Env
end; end;
@ -279,10 +282,13 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R
Attrs = get_attributes(Ann), Attrs = get_attributes(Ann),
FName = lookup_fun(Env, qname(Env, Name)), FName = lookup_fun(Env, qname(Env, Name)),
FArgs = args_to_fcode(Env, Args), FArgs = args_to_fcode(Env, Args),
FRet = type_to_fcode(Env, Ret),
FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body), FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body),
[ ensure_first_order_entrypoint(Ann, FArgs, FRet)
|| aeso_syntax:get_ann(entrypoint, Ann, false) ],
Def = #{ attrs => Attrs, Def = #{ attrs => Attrs,
args => FArgs, args => FArgs,
return => type_to_fcode(Env, Ret), return => FRet,
body => FBody }, body => FBody },
NewFuns = Funs#{ FName => Def }, NewFuns = Funs#{ FName => Def },
Env#{ functions := NewFuns }. Env#{ functions := NewFuns }.
@ -450,12 +456,16 @@ expr_to_fcode(Env, _Type, {list, _, Es}) ->
lists:foldr(fun(E, L) -> {op, '::', [expr_to_fcode(Env, E), L]} end, lists:foldr(fun(E, L) -> {op, '::', [expr_to_fcode(Env, E), L]} end,
nil, Es); nil, Es);
expr_to_fcode(Env, _Type, {app, _, {'..', _}, [A, B]}) ->
{def_u, FromTo, _} = resolve_fun(Env, ["ListInternal", "from_to"]),
{def, FromTo, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]};
expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) -> expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) ->
{op, '::', [expr_to_fcode(Env, Yield), nil]}; {op, '::', [expr_to_fcode(Env, Yield), nil]};
expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, {typed, {id, _, Arg}, _}, BindExpr}|Rest]}) -> expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, {typed, {id, _, Arg}, _}, BindExpr}|Rest]}) ->
Env1 = bind_var(Env, Arg), Env1 = bind_var(Env, Arg),
Bind = {lam, [Arg], expr_to_fcode(Env1, {list_comp, As, Yield, Rest})}, Bind = {lam, [Arg], expr_to_fcode(Env1, {list_comp, As, Yield, Rest})},
{def_u, FlatMap, _} = resolve_fun(Env, ["List", "flat_map"]), {def_u, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]),
{def, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]}; {def, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]};
expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) -> expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) ->
make_if(expr_to_fcode(Env, Cond), make_if(expr_to_fcode(Env, Cond),
@ -503,7 +513,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) ->
end; end;
%% Function calls %% Function calls
expr_to_fcode(Env, Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT, _, _}}, Args}) -> expr_to_fcode(Env, Type, {app, _, Fun = {typed, _, _, {fun_t, _, NamedArgsT, _, _}}, Args}) ->
Args1 = get_named_args(NamedArgsT, Args), Args1 = get_named_args(NamedArgsT, Args),
FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1],
case expr_to_fcode(Env, Fun) of case expr_to_fcode(Env, Fun) of
@ -517,11 +527,13 @@ expr_to_fcode(Env, Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT,
%% Get the type of the oracle from the args or the expression itself %% Get the type of the oracle from the args or the expression itself
OType = get_oracle_type(B, Type, Args1), OType = get_oracle_type(B, Type, Args1),
{oracle, QType, RType} = type_to_fcode(Env, OType), {oracle, QType, RType} = type_to_fcode(Env, OType),
validate_oracle_type(aeso_syntax:get_ann(Fun), QType, RType),
TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}], TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
builtin_to_fcode(B, FArgs ++ TypeArgs); builtin_to_fcode(B, FArgs ++ TypeArgs);
{builtin_u, B, _} when B =:= aens_resolve -> {builtin_u, B, _} when B =:= aens_resolve ->
%% Get the type we are assuming the name resolves to %% Get the type we are assuming the name resolves to
AensType = type_to_fcode(Env, Type), AensType = type_to_fcode(Env, Type),
validate_aens_resolve_type(aeso_syntax:get_ann(Fun), AensType),
TypeArgs = [{lit, {typerep, AensType}}], TypeArgs = [{lit, {typerep, AensType}}],
builtin_to_fcode(B, FArgs ++ TypeArgs); builtin_to_fcode(B, FArgs ++ TypeArgs);
{builtin_u, B, _Ar} -> builtin_to_fcode(B, FArgs); {builtin_u, B, _Ar} -> builtin_to_fcode(B, FArgs);
@ -597,6 +609,46 @@ get_oracle_type(oracle_check, _Type, [{typed, _, _Expr, OType}]) ->
get_oracle_type(oracle_check_query, _Type, [{typed, _, _Expr, OType} | _]) -> OType; get_oracle_type(oracle_check_query, _Type, [{typed, _, _Expr, OType} | _]) -> OType;
get_oracle_type(oracle_respond, _Type, [_, {typed, _,_Expr, OType} | _]) -> OType. get_oracle_type(oracle_respond, _Type, [_, {typed, _,_Expr, OType} | _]) -> OType.
validate_oracle_type(Ann, QType, RType) ->
ensure_monomorphic(QType, {polymorphic_query_type, Ann, QType}),
ensure_monomorphic(RType, {polymorphic_response_type, Ann, RType}),
ensure_first_order(QType, {higher_order_query_type, Ann, QType}),
ensure_first_order(RType, {higher_order_response_type, Ann, RType}),
ok.
validate_aens_resolve_type(Ann, {variant, [[], [Type]]}) ->
ensure_monomorphic(Type, {polymorphic_aens_resolve, Ann, Type}),
ensure_first_order(Type, {higher_order_aens_resolve, Ann, Type}),
ok.
ensure_first_order_entrypoint(Ann, Args, Ret) ->
[ ensure_first_order(T, {higher_order_entrypoint_argument, Ann, X, T})
|| {X, T} <- Args ],
ensure_first_order(Ret, {higher_order_entrypoint_return, Ann, Ret}),
ok.
ensure_monomorphic(Type, Err) ->
case is_monomorphic(Type) of
true -> ok;
false -> fcode_error(Err)
end.
ensure_first_order(Type, Err) ->
case is_first_order(Type) of
true -> ok;
false -> fcode_error(Err)
end.
is_monomorphic({tvar, _}) -> false;
is_monomorphic(Ts) when is_list(Ts) -> lists:all(fun is_monomorphic/1, Ts);
is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
is_monomorphic(_) -> true.
is_first_order({function, _, _}) -> false;
is_first_order(Ts) when is_list(Ts) -> lists:all(fun is_first_order/1, Ts);
is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
is_first_order(_) -> true.
%% -- Pattern matching -- %% -- Pattern matching --
-spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit(). -spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit().
@ -852,16 +904,30 @@ builtin_to_fcode(Builtin, Args) ->
%% -- Init function -- %% -- Init function --
add_init_function(_Env, Funs) -> add_init_function(Env, StateType, Funs0) ->
case is_no_code(Env) of
true -> Funs0;
false ->
Funs = add_default_init_function(Env, StateType, Funs0),
InitName = {entrypoint, <<"init">>}, InitName = {entrypoint, <<"init">>},
InitFun = #{ args := InitArgs } = InitFun = #{ args := InitArgs } = maps:get(InitName, Funs, none),
case maps:get(InitName, Funs, none) of
none -> #{ attrs => [], args => [], return => {tuple, []}, body => {tuple, []} };
Info -> Info
end,
Vars = [ {var, X} || {X, _} <- InitArgs ], Vars = [ {var, X} || {X, _} <- InitArgs ],
Funs#{ init => InitFun#{ return => {tuple, []}, Funs#{ init => InitFun#{ return => {tuple, []},
body => {builtin, set_state, [{def, InitName, Vars}]} } }. body => {builtin, set_state, [{def, InitName, Vars}]} } }
end.
add_default_init_function(_Env, StateType, Funs) ->
InitName = {entrypoint, <<"init">>},
case maps:get(InitName, Funs, none) of
%% Only add default init function if state is unit.
none when StateType == {tuple, []} ->
Funs#{ InitName => #{attrs => [],
args => [],
return => {tuple, []},
body => {tuple, []}} };
none -> fcode_error(missing_init_function);
_ -> Funs
end.
%% -- Event function -- %% -- Event function --
@ -990,13 +1056,16 @@ lambda_lift_exprs(As) -> [lambda_lift_expr(A) || A <- As].
-spec optimize_fcode(fcode()) -> fcode(). -spec optimize_fcode(fcode()) -> fcode().
optimize_fcode(Code = #{ functions := Funs }) -> optimize_fcode(Code = #{ functions := Funs }) ->
Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def) end, Funs) }. Code1 = Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def) end, Funs) },
eliminate_dead_code(Code1).
-spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def(). -spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def().
optimize_fun(Fcode, Fun, Def = #{ body := Body }) -> optimize_fun(Fcode, Fun, Def = #{ body := Body }) ->
%% io:format("Optimizing ~p =\n~s\n", [_Fun, prettypr:format(pp_fexpr(_Body))]), %% io:format("Optimizing ~p =\n~s\n", [_Fun, prettypr:format(pp_fexpr(_Body))]),
Def#{ body := inliner(Fcode, Fun, Body) }. Def#{ body := inliner(Fcode, Fun, Body) }.
%% --- Inlining ---
-spec inliner(fcode(), fun_name(), fexpr()) -> fexpr(). -spec inliner(fcode(), fun_name(), fexpr()) -> fexpr().
inliner(Fcode, Fun, {def, Fun1, Args} = E) when Fun1 /= Fun -> inliner(Fcode, Fun, {def, Fun1, Args} = E) when Fun1 /= Fun ->
case should_inline(Fcode, Fun1) of case should_inline(Fcode, Fun1) of
@ -1009,6 +1078,33 @@ should_inline(_Fcode, _Fun1) -> false == list_to_atom("true"). %% Dialyzer
inline(_Fcode, Fun, Args) -> {def, Fun, Args}. %% TODO inline(_Fcode, Fun, Args) -> {def, Fun, Args}. %% TODO
%% --- Deadcode elimination ---
-spec eliminate_dead_code(fcode()) -> fcode().
eliminate_dead_code(Code = #{ functions := Funs }) ->
UsedFuns = used_functions(Funs),
Code#{ functions := maps:filter(fun(Name, _) -> maps:is_key(Name, UsedFuns) end,
Funs) }.
-spec used_functions(#{ fun_name() => fun_def() }) -> #{ fun_name() => true }.
used_functions(Funs) ->
Exported = [ Fun || {Fun, #{ attrs := Attrs }} <- maps:to_list(Funs),
not lists:member(private, Attrs) ],
used_functions(#{}, Exported, Funs).
used_functions(Used, [], _) -> Used;
used_functions(Used, [Name | Rest], Defs) ->
case maps:is_key(Name, Used) of
true -> used_functions(Used, Rest, Defs);
false ->
New =
case maps:get(Name, Defs, undef) of
undef -> []; %% We might be compiling a stub
#{ body := Body } -> used_defs(Body)
end,
used_functions(Used#{ Name => true }, New ++ Rest, Defs)
end.
%% -- Helper functions ------------------------------------------------------- %% -- Helper functions -------------------------------------------------------
%% -- Types -- %% -- Types --
@ -1178,6 +1274,34 @@ free_vars(Expr) ->
{'case', P, A} -> free_vars(A) -- lists:sort(fsplit_pat_vars(P)) {'case', P, A} -> free_vars(A) -- lists:sort(fsplit_pat_vars(P))
end. end.
used_defs(Xs) when is_list(Xs) ->
lists:umerge([ used_defs(X) || X <- Xs ]);
used_defs(Expr) ->
case Expr of
{var, _} -> [];
{lit, _} -> [];
nil -> [];
{def, F, As} -> lists:umerge([F], used_defs(As));
{def_u, F, _} -> [F];
{remote, _, _, Ct, _, As} -> used_defs([Ct | As]);
{remote_u, _, _, Ct, _} -> used_defs(Ct);
{builtin, _, As} -> used_defs(As);
{builtin_u, _, _} -> [];
{con, _, _, As} -> used_defs(As);
{tuple, As} -> used_defs(As);
{proj, A, _} -> used_defs(A);
{set_proj, A, _, B} -> used_defs([A, B]);
{op, _, As} -> used_defs(As);
{'let', _, A, B} -> used_defs([A, B]);
{funcall, A, Bs} -> used_defs([A | Bs]);
{lam, _, B} -> used_defs(B);
{closure, F, A} -> lists:umerge([F], used_defs(A));
{switch, A} -> used_defs(A);
{split, _, _, As} -> used_defs(As);
{nosplit, A} -> used_defs(A);
{'case', _, A} -> used_defs(A)
end.
get_named_args(NamedArgsT, Args) -> get_named_args(NamedArgsT, Args) ->
IsNamed = fun({named_arg, _, _, _}) -> true; IsNamed = fun({named_arg, _, _, _}) -> true;
(_) -> false end, (_) -> false end,
@ -1476,4 +1600,3 @@ pp_pat(Pat) -> pp_fexpr(Pat).
is_infix(Op) -> is_infix(Op) ->
C = hd(atom_to_list(Op)), C = hd(atom_to_list(Op)),
C < $a orelse C > $z. C < $a orelse C > $z.

84
src/aeso_ast_to_icode.erl
View File

@ -93,6 +93,8 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest]
FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++ FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++
[ payable || proplists:get_value(payable, Attrib, false) ] ++ [ payable || proplists:get_value(payable, Attrib, false) ] ++
[ private || is_private(Attrib, Icode) ], [ private || is_private(Attrib, Icode) ],
[ check_entrypoint_type(Attrib, Name, Args, T)
|| aeso_syntax:get_ann(entrypoint, Attrib, false) ],
%% TODO: Handle types %% TODO: Handle types
FunName = ast_id(Name), FunName = ast_id(Name),
%% TODO: push funname to env %% TODO: push funname to env
@ -105,7 +107,7 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest]
#{ state_type := StateType } = Icode, #{ state_type := StateType } = Icode,
{#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] }, {#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] },
{tuple, [typerep, ast_typerep(T, Icode)]}}; {tuple, [typerep, ast_typerep(T, Icode)]}};
_ -> {ast_body(Body, Icode), ast_typerep(T, Icode)} _ -> {ast_body(Body, Icode), ast_typerep1(T, Icode)}
end, end,
QName = aeso_icode:qualify(Name, Icode), QName = aeso_icode:qualify(Name, Icode),
NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode), NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode),
@ -121,7 +123,7 @@ ast_id({id, _, Id}) -> Id;
ast_id({qid, _, Id}) -> Id. ast_id({qid, _, Id}) -> Id.
ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) -> ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) ->
ast_args(Rest, [{ast_id(Name), ast_type(Type, Icode)}| Acc], Icode); ast_args(Rest, [{ast_id(Name), ast_typerep1(Type, Icode)}| Acc], Icode);
ast_args([], Acc, _Icode) -> lists:reverse(Acc). ast_args([], Acc, _Icode) -> lists:reverse(Acc).
ast_type(T, Icode) -> ast_type(T, Icode) ->
@ -268,10 +270,10 @@ ast_body(?qid_app(["AENS", "preclaim"], Args, _, _), Icode) ->
[word, word, sign_t()], {tuple, []}); [word, word, sign_t()], {tuple, []});
ast_body(?qid_app(["AENS", "claim"], Args, _, _), Icode) -> ast_body(?qid_app(["AENS", "claim"], Args, _, _), Icode) ->
{Sign, [Addr, Name, Salt]} = get_signature_arg(Args), {Sign, [Addr, Name, Salt, NameFee]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_AENS_CLAIM, #integer{value = 0}, prim_call(?PRIM_CALL_AENS_CLAIM, #integer{value = 0},
[ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Salt, Icode), ast_body(Sign, Icode)], [ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Salt, Icode), ast_body(NameFee, Icode), ast_body(Sign, Icode)],
[word, string, word, sign_t()], {tuple, []}); [word, string, word, word, sign_t()], {tuple, []});
ast_body(?qid_app(["AENS", "transfer"], Args, _, _), Icode) -> ast_body(?qid_app(["AENS", "transfer"], Args, _, _), Icode) ->
{Sign, [FromAddr, ToAddr, Name]} = get_signature_arg(Args), {Sign, [FromAddr, ToAddr, Name]} = get_signature_arg(Args),
@ -523,6 +525,10 @@ ast_body({app, _, {typed, _, {con, _, Name}, _}, Args}, Icode) ->
ast_body({app, _, {typed, _, {qcon, _, Name}, _}, Args}, Icode) -> ast_body({app, _, {typed, _, {qcon, _, Name}, _}, Args}, Icode) ->
Tag = aeso_icode:get_constructor_tag(Name, Icode), Tag = aeso_icode:get_constructor_tag(Name, Icode),
#tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]}; #tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]};
ast_body({app, _, {'..', _}, [A, B]}, Icode) ->
#funcall
{ function = #var_ref{ name = ["ListInternal", "from_to"] }
, args = [ast_body(A, Icode), ast_body(B, Icode)] };
ast_body({app,As,Fun,Args}, Icode) -> ast_body({app,As,Fun,Args}, Icode) ->
case aeso_syntax:get_ann(format, As) of case aeso_syntax:get_ann(format, As) of
infix -> infix ->
@ -541,7 +547,7 @@ ast_body({list_comp, _, Yield, []}, Icode) ->
#list{elems = [ast_body(Yield, Icode)]}; #list{elems = [ast_body(Yield, Icode)]};
ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, Arg, ArgType}, BindExpr}|Rest]}, Icode) -> ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, Arg, ArgType}, BindExpr}|Rest]}, Icode) ->
#funcall #funcall
{ function = #var_ref{ name = ["List", "flat_map"] } { function = #var_ref{ name = ["ListInternal", "flat_map"] }
, args = , args =
[ #lambda{ args=[#arg{name = ast_id(Arg), type = ast_type(ArgType, Icode)}] [ #lambda{ args=[#arg{name = ast_id(Arg), type = ast_type(ArgType, Icode)}]
, body = ast_body({list_comp, As, Yield, Rest}, Icode) , body = ast_body({list_comp, As, Yield, Rest}, Icode)
@ -578,7 +584,7 @@ ast_body({block,As,[E|Rest]}, Icode) ->
#switch{expr=ast_body(E, Icode), #switch{expr=ast_body(E, Icode),
cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, Icode)}]}; cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, Icode)}]};
ast_body({lam,_,Args,Body}, Icode) -> ast_body({lam,_,Args,Body}, Icode) ->
#lambda{args=[#arg{name = ast_id(P), type = ast_type(T, Icode)} || {arg,_,P,T} <- Args], #lambda{args=[#arg{name = ast_id(P), type = ast_typerep1(T, Icode)} || {arg,_,P,T} <- Args],
body=ast_body(Body, Icode)}; body=ast_body(Body, Icode)};
ast_body({typed,_,{record,Attrs,Fields},{record_t,DefFields}}, Icode) -> ast_body({typed,_,{record,Attrs,Fields},{record_t,DefFields}}, Icode) ->
%% Compile as a tuple with the fields in the order they appear in the definition. %% Compile as a tuple with the fields in the order they appear in the definition.
@ -713,6 +719,22 @@ map_upd(Key, Default, ValFun, Map = {typed, Ann, _, MapType}, Icode) ->
Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Default, Icode), ast_body(ValFun, Icode)], Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Default, Icode), ast_body(ValFun, Icode)],
builtin_call(FunName, Args). builtin_call(FunName, Args).
check_entrypoint_type(Ann, Name, Args, Ret) ->
Check = fun(T, Err) ->
case is_simple_type(T) of
false -> gen_error(Err);
true -> ok
end end,
[ Check(T, {entrypoint_argument_must_have_simple_type, Ann1, Name, X, T})
|| {arg, Ann1, X, T} <- Args ],
Check(Ret, {entrypoint_must_have_simple_return_type, Ann, Name, Ret}).
is_simple_type({tvar, _, _}) -> false;
is_simple_type({fun_t, _, _, _, _}) -> false;
is_simple_type(Ts) when is_list(Ts) -> lists:all(fun is_simple_type/1, Ts);
is_simple_type(T) when is_tuple(T) -> is_simple_type(tuple_to_list(T));
is_simple_type(_) -> true.
is_monomorphic({tvar, _, _}) -> false; is_monomorphic({tvar, _, _}) -> false;
is_monomorphic([H|T]) -> is_monomorphic([H|T]) ->
is_monomorphic(H) andalso is_monomorphic(T); is_monomorphic(H) andalso is_monomorphic(T);
@ -753,42 +775,49 @@ make_type_def(Args, Def, Icode = #{ type_vars := TypeEnv }) ->
TVars = [ X || {tvar, _, X} <- Args ], TVars = [ X || {tvar, _, X} <- Args ],
fun(Types) -> fun(Types) ->
TypeEnv1 = maps:from_list(lists:zip(TVars, Types)), TypeEnv1 = maps:from_list(lists:zip(TVars, Types)),
ast_typerep(Def, Icode#{ type_vars := maps:merge(TypeEnv, TypeEnv1) }) ast_typerep1(Def, Icode#{ type_vars := maps:merge(TypeEnv, TypeEnv1) })
end. end.
-spec ast_typerep(aeso_syntax:type()) -> aeb_aevm_data:type(). -spec ast_typerep(aeso_syntax:type()) -> aeb_aevm_data:type().
ast_typerep(Type) -> ast_typerep(Type, aeso_icode:new([])). ast_typerep(Type) ->
ast_typerep(Type, aeso_icode:new([])).
ast_typerep({id, _, Name}, Icode) -> ast_typerep(Type, Icode) ->
case is_simple_type(Type) of
false -> gen_error({not_a_simple_type, Type});
true -> ast_typerep1(Type, Icode)
end.
ast_typerep1({id, _, Name}, Icode) ->
lookup_type_id(Name, [], Icode); lookup_type_id(Name, [], Icode);
ast_typerep({qid, _, Name}, Icode) -> ast_typerep1({qid, _, Name}, Icode) ->
lookup_type_id(Name, [], Icode); lookup_type_id(Name, [], Icode);
ast_typerep({con, _, _}, _) -> ast_typerep1({con, _, _}, _) ->
word; %% Contract type word; %% Contract type
ast_typerep({bytes_t, _, Len}, _) -> ast_typerep1({bytes_t, _, Len}, _) ->
bytes_t(Len); bytes_t(Len);
ast_typerep({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid -> ast_typerep1({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid ->
ArgReps = [ ast_typerep(Arg, Icode) || Arg <- Args ], ArgReps = [ ast_typerep1(Arg, Icode) || Arg <- Args ],
lookup_type_id(Name, ArgReps, Icode); lookup_type_id(Name, ArgReps, Icode);
ast_typerep({tvar,_,A}, #{ type_vars := TypeVars }) -> ast_typerep1({tvar,_,A}, #{ type_vars := TypeVars }) ->
case maps:get(A, TypeVars, undefined) of case maps:get(A, TypeVars, undefined) of
undefined -> word; %% We serialize type variables just as addresses in the originating VM. undefined -> word; %% We serialize type variables just as addresses in the originating VM.
Type -> Type Type -> Type
end; end;
ast_typerep({tuple_t,_,Cpts}, Icode) -> ast_typerep1({tuple_t,_,Cpts}, Icode) ->
{tuple, [ast_typerep(C, Icode) || C<-Cpts]}; {tuple, [ast_typerep1(C, Icode) || C<-Cpts]};
ast_typerep({record_t,Fields}, Icode) -> ast_typerep1({record_t,Fields}, Icode) ->
{tuple, [ begin {tuple, [ begin
{field_t, _, _, T} = Field, {field_t, _, _, T} = Field,
ast_typerep(T, Icode) ast_typerep1(T, Icode)
end || Field <- Fields]}; end || Field <- Fields]};
ast_typerep({fun_t,_,_,_,_}, _Icode) -> ast_typerep1({fun_t,_,_,_,_}, _Icode) ->
function; function;
ast_typerep({alias_t, T}, Icode) -> ast_typerep(T, Icode); ast_typerep1({alias_t, T}, Icode) -> ast_typerep1(T, Icode);
ast_typerep({variant_t, Cons}, Icode) -> ast_typerep1({variant_t, Cons}, Icode) ->
{variant, [ begin {variant, [ begin
{constr_t, _, _, Args} = Con, {constr_t, _, _, Args} = Con,
[ ast_typerep(Arg, Icode) || Arg <- Args ] [ ast_typerep1(Arg, Icode) || Arg <- Args ]
end || Con <- Cons ]}. end || Con <- Cons ]}.
ttl_t(Icode) -> ttl_t(Icode) ->
@ -837,13 +866,6 @@ type_value({map, K, V}) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG }, #tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG },
type_value(K), type_value(V)] }. type_value(K), type_value(V)] }.
%% As abort is a built-in in the future it will be illegal to for
%% users to define abort. For the time being strip away all user
%% defined abort functions.
ast_fun_to_icode("abort", _Atts, _Args, _Body, _TypeRep, Icode) ->
%% Strip away all user defined abort functions.
Icode;
ast_fun_to_icode(Name, Attrs, Args, Body, TypeRep, #{functions := Funs} = Icode) -> ast_fun_to_icode(Name, Attrs, Args, Body, TypeRep, #{functions := Funs} = Icode) ->
NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs], NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs],
aeso_icode:set_functions(NewFuns, Icode). aeso_icode:set_functions(NewFuns, Icode).

21
src/aeso_compiler.erl
View File

@ -36,7 +36,6 @@
| pp_assembler | pp_assembler
| pp_bytecode | pp_bytecode
| no_code | no_code
| no_implicit_stdlib
| {backend, aevm | fate} | {backend, aevm | fate}
| {include, {file_system, [string()]} | | {include, {file_system, [string()]} |
{explicit_files, #{string() => binary()}}} {explicit_files, #{string() => binary()}}}
@ -142,16 +141,7 @@ from_string1(fate, ContractString, Options) ->
-spec string_to_code(string(), options()) -> map(). -spec string_to_code(string(), options()) -> map().
string_to_code(ContractString, Options) -> string_to_code(ContractString, Options) ->
Ast = case lists:member(no_implicit_stdlib, Options) of Ast = parse(ContractString, Options),
true -> parse(ContractString, Options);
false ->
IncludedSTD = sets:from_list(
[aeso_parser:hash_include(F, C)
|| {F, C} <- aeso_stdlib:stdlib_list()]),
InitAst = parse(ContractString, IncludedSTD, Options),
STD = parse_stdlib(),
STD ++ InitAst
end,
pp_sophia_code(Ast, Options), pp_sophia_code(Ast, Options),
pp_ast(Ast, Options), pp_ast(Ast, Options),
{TypeEnv, TypedAst} = aeso_ast_infer_types:infer(Ast, [return_env]), {TypeEnv, TypedAst} = aeso_ast_infer_types:infer(Ast, [return_env]),
@ -579,15 +569,6 @@ pp(Code, Options, Option, PPFun) ->
%% ------------------------------------------------------------------- %% -------------------------------------------------------------------
-spec parse_stdlib() -> none() | aeso_syntax:ast().
parse_stdlib() ->
lists:foldr(
fun ({Lib, LibCode}, Acc) ->
parse(LibCode, [{src_file, binary_to_list(Lib)}]) ++ Acc
end,
[],
aeso_stdlib:stdlib_list()).
sophia_type_to_typerep(String) -> sophia_type_to_typerep(String) ->
{ok, Ast} = aeso_parser:type(String), {ok, Ast} = aeso_parser:type(String),
try aeso_ast_to_icode:ast_typerep(Ast) of try aeso_ast_to_icode:ast_typerep(Ast) of

144
src/aeso_fcode_to_fate.erl
View File

@ -114,13 +114,16 @@
Op =:= 'CREATOR' orelse Op =:= 'CREATOR' orelse
false)). false)).
-record(env, { contract, vars = [], locals = [], tailpos = true }). -record(env, { contract, vars = [], locals = [], current_function, tailpos = true }).
%% -- Debugging -------------------------------------------------------------- %% -- Debugging --------------------------------------------------------------
debug(Tag, Options, Fmt, Args) -> is_debug(Tag, Options) ->
Tags = proplists:get_value(debug, Options, []), Tags = proplists:get_value(debug, Options, []),
case Tags == all orelse lists:member(Tag, Tags) of Tags == all orelse lists:member(Tag, Tags).
debug(Tag, Options, Fmt, Args) ->
case is_debug(Tag, Options) of
true -> io:format(Fmt, Args); true -> io:format(Fmt, Args);
false -> ok false -> ok
end. end.
@ -130,12 +133,10 @@ debug(Tag, Options, Fmt, Args) ->
%% @doc Main entry point. %% @doc Main entry point.
compile(FCode, Options) -> compile(FCode, Options) ->
#{ contract_name := ContractName, #{ contract_name := ContractName,
state_type := StateType,
functions := Functions } = FCode, functions := Functions } = FCode,
SFuns = functions_to_scode(ContractName, Functions, Options), SFuns = functions_to_scode(ContractName, Functions, Options),
SFuns1 = optimize_scode(SFuns, Options), SFuns1 = optimize_scode(SFuns, Options),
SFuns2 = add_default_init_function(SFuns1, StateType), FateCode = to_basic_blocks(SFuns1),
FateCode = to_basic_blocks(SFuns2),
debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]), debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]),
FateCode. FateCode.
@ -156,10 +157,10 @@ functions_to_scode(ContractName, Functions, Options) ->
attrs := Attrs, attrs := Attrs,
return := Type}} <- maps:to_list(Functions)]). return := Type}} <- maps:to_list(Functions)]).
function_to_scode(ContractName, Functions, _Name, Attrs0, Args, Body, ResType, _Options) -> function_to_scode(ContractName, Functions, Name, Attrs0, Args, Body, ResType, _Options) ->
{ArgTypes, ResType1} = typesig_to_scode(Args, ResType), {ArgTypes, ResType1} = typesig_to_scode(Args, ResType),
Attrs = Attrs0 -- [stateful], %% Only track private and payable from here. Attrs = Attrs0 -- [stateful], %% Only track private and payable from here.
SCode = to_scode(init_env(ContractName, Functions, Args), Body), SCode = to_scode(init_env(ContractName, Functions, Name, Args), Body),
{Attrs, {ArgTypes, ResType1}, SCode}. {Attrs, {ArgTypes, ResType1}, SCode}.
-define(tvars, '$tvars'). -define(tvars, '$tvars').
@ -196,30 +197,16 @@ type_to_scode({tvar, X}) ->
J -> {tvar, J} J -> {tvar, J}
end. end.
add_default_init_function(SFuns, StateType) when StateType /= {tuple, []} ->
%% Only add default if the type is unit.
SFuns;
add_default_init_function(SFuns, {tuple, []}) ->
%% Only add default if the init function is not present
InitName = make_function_name({entrypoint, <<"init">>}),
case maps:find(InitName, SFuns) of
{ok, _} ->
SFuns;
error ->
Sig = {[], {tuple, []}},
Body = [tuple(0)],
SFuns#{ InitName => {[], Sig, Body} }
end.
%% -- Phase I ---------------------------------------------------------------- %% -- Phase I ----------------------------------------------------------------
%% Icode to structured assembly %% Icode to structured assembly
%% -- Environment functions -- %% -- Environment functions --
init_env(ContractName, FunNames, Args) -> init_env(ContractName, FunNames, Name, Args) ->
#env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], #env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ],
contract = ContractName, contract = ContractName,
locals = FunNames, locals = FunNames,
current_function = Name,
tailpos = true }. tailpos = true }.
next_var(#env{ vars = Vars }) -> next_var(#env{ vars = Vars }) ->
@ -322,6 +309,24 @@ to_scode(Env, {'let', X, Expr, Body}) ->
aeb_fate_ops:store({var, I}, {stack, 0}), aeb_fate_ops:store({var, I}, {stack, 0}),
to_scode(Env1, Body) ]; to_scode(Env1, Body) ];
to_scode(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) ->
%% Tail-call to current function, f(e0..en). Compile to
%% [ let xi = ei ]
%% [ STORE argi xi ]
%% jump 0
{Vars, Code, _Env} =
lists:foldl(fun(Arg, {Is, Acc, Env1}) ->
{I, Env2} = bind_local("_", Env1),
ArgCode = to_scode(notail(Env2), Arg),
Acc1 = [Acc, ArgCode,
aeb_fate_ops:store({var, I}, ?a)],
{[I | Is], Acc1, Env2}
end, {[], [], Env}, Args),
[ Code,
[ aeb_fate_ops:store({arg, I}, {var, J})
|| {I, J} <- lists:zip(lists:seq(0, length(Vars) - 1),
lists:reverse(Vars)) ],
loop ];
to_scode(Env, {def, Fun, Args}) -> to_scode(Env, {def, Fun, Args}) ->
FName = make_function_id(Fun), FName = make_function_id(Fun),
Lbl = aeb_fate_data:make_string(FName), Lbl = aeb_fate_data:make_string(FName),
@ -552,8 +557,8 @@ builtin_to_scode(Env, aens_resolve, [_Name, _Key, _Type] = Args) ->
builtin_to_scode(Env, aens_preclaim, [_Sign, _Account, _Hash] = Args) -> builtin_to_scode(Env, aens_preclaim, [_Sign, _Account, _Hash] = Args) ->
call_to_scode(Env, [aeb_fate_ops:aens_preclaim(?a, ?a, ?a), call_to_scode(Env, [aeb_fate_ops:aens_preclaim(?a, ?a, ?a),
tuple(0)], Args); tuple(0)], Args);
builtin_to_scode(Env, aens_claim, [_Sign, _Account, _NameString, _Salt] = Args) -> builtin_to_scode(Env, aens_claim, [_Sign, _Account, _NameString, _Salt, _NameFee] = Args) ->
call_to_scode(Env, [aeb_fate_ops:aens_claim(?a, ?a, ?a, ?a), call_to_scode(Env, [aeb_fate_ops:aens_claim(?a, ?a, ?a, ?a, ?a),
tuple(0)], Args); tuple(0)], Args);
builtin_to_scode(Env, aens_transfer, [_Sign, _From, _To, _Name] = Args) -> builtin_to_scode(Env, aens_transfer, [_Sign, _From, _To, _Name] = Args) ->
call_to_scode(Env, [aeb_fate_ops:aens_transfer(?a, ?a, ?a, ?a), call_to_scode(Env, [aeb_fate_ops:aens_transfer(?a, ?a, ?a, ?a),
@ -679,12 +684,15 @@ pp_ann(Ind, [{i, #{ live_in := In, live_out := Out }, I} | Code]) ->
Fmt = fun([]) -> "()"; Fmt = fun([]) -> "()";
(Xs) -> string:join([lists:concat(["var", N]) || {var, N} <- Xs], " ") (Xs) -> string:join([lists:concat(["var", N]) || {var, N} <- Xs], " ")
end, end,
Op = [Ind, aeb_fate_pp:format_op(I, #{})], Op = [Ind, pp_op(I)],
Ann = [[" % ", Fmt(In), " -> ", Fmt(Out)] || In ++ Out /= []], Ann = [[" % ", Fmt(In), " -> ", Fmt(Out)] || In ++ Out /= []],
[io_lib:format("~-40s~s\n", [Op, Ann]), [io_lib:format("~-40s~s\n", [Op, Ann]),
pp_ann(Ind, Code)]; pp_ann(Ind, Code)];
pp_ann(_, []) -> []. pp_ann(_, []) -> [].
pp_op(loop) -> "LOOP";
pp_op(I) ->
aeb_fate_pp:format_op(I, #{}).
pp_arg(?i(I)) -> io_lib:format("~w", [I]); pp_arg(?i(I)) -> io_lib:format("~w", [I]);
pp_arg({arg, N}) -> io_lib:format("arg~p", [N]); pp_arg({arg, N}) -> io_lib:format("arg~p", [N]);
@ -751,6 +759,7 @@ attributes(I) ->
Pure = fun(W, R) -> Attr(W, R, true) end, Pure = fun(W, R) -> Attr(W, R, true) end,
Impure = fun(W, R) -> Attr(W, R, false) end, Impure = fun(W, R) -> Attr(W, R, false) end,
case I of case I of
loop -> Impure(pc, []);
'RETURN' -> Impure(pc, []); 'RETURN' -> Impure(pc, []);
{'RETURNR', A} -> Impure(pc, A); {'RETURNR', A} -> Impure(pc, A);
{'CALL', _} -> Impure(?a, []); {'CALL', _} -> Impure(?a, []);
@ -874,7 +883,7 @@ attributes(I) ->
{'ORACLE_QUERY_FEE', A, B} -> Impure(A, [B]); {'ORACLE_QUERY_FEE', A, B} -> Impure(A, [B]);
{'AENS_RESOLVE', A, B, C, D} -> Impure(A, [B, C, D]); {'AENS_RESOLVE', A, B, C, D} -> Impure(A, [B, C, D]);
{'AENS_PRECLAIM', A, B, C} -> Impure(none, [A, B, C]); {'AENS_PRECLAIM', A, B, C} -> Impure(none, [A, B, C]);
{'AENS_CLAIM', A, B, C, D} -> Impure(none, [A, B, C, D]); {'AENS_CLAIM', A, B, C, D, E} -> Impure(none, [A, B, C, D, E]);
'AENS_UPDATE' -> Impure(none, []);%% TODO 'AENS_UPDATE' -> Impure(none, []);%% TODO
{'AENS_TRANSFER', A, B, C, D} -> Impure(none, [A, B, C, D]); {'AENS_TRANSFER', A, B, C, D} -> Impure(none, [A, B, C, D]);
{'AENS_REVOKE', A, B, C} -> Impure(none, [A, B, C]); {'AENS_REVOKE', A, B, C} -> Impure(none, [A, B, C]);
@ -953,15 +962,29 @@ simpl_s({switch, Arg, Type, Alts, Def}, Options) ->
{switch, Arg, Type, [simplify(A, Options) || A <- Alts], simplify(Def, Options)}; {switch, Arg, Type, [simplify(A, Options) || A <- Alts], simplify(Def, Options)};
simpl_s(I, _) -> I. simpl_s(I, _) -> I.
simpl_top(I, Code, Options) -> %% Safe-guard against loops in the rewriting. Shouldn't happen so throw an
apply_rules(rules(), I, Code, Options). %% error if we run out.
-define(SIMPL_FUEL, 5000).
apply_rules(Rules, I, Code, Options) -> simpl_top(I, Code, Options) ->
Cons = fun(X, Xs) -> simpl_top(X, Xs, Options) end, simpl_top(?SIMPL_FUEL, I, Code, Options).
simpl_top(0, I, Code, _Options) ->
error({out_of_fuel, I, Code});
simpl_top(Fuel, I, Code, Options) ->
apply_rules(Fuel, rules(), I, Code, Options).
apply_rules(Fuel, Rules, I, Code, Options) ->
Cons = fun(X, Xs) -> simpl_top(Fuel - 1, X, Xs, Options) end,
case apply_rules_once(Rules, I, Code) of case apply_rules_once(Rules, I, Code) of
false -> [I | Code]; false -> [I | Code];
{RName, New, Rest} -> {RName, New, Rest} ->
debug(opt_rules, Options, " Applied ~p:\n~s ==>\n~s\n", [RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), case is_debug(opt_rules, Options) of
true ->
{OldCode, NewCode} = drop_common_suffix([I | Code], New ++ Rest),
debug(opt_rules, Options, " Applied ~p:\n~s ==>\n~s\n", [RName, pp_ann(" ", OldCode), pp_ann(" ", NewCode)]);
false -> ok
end,
lists:foldr(Cons, Rest, New) lists:foldr(Cons, Rest, New)
end. end.
@ -985,6 +1008,7 @@ merge_rules() ->
rules() -> rules() ->
merge_rules() ++ merge_rules() ++
[?RULE(r_swap_push), [?RULE(r_swap_push),
?RULE(r_swap_pop),
?RULE(r_swap_write), ?RULE(r_swap_write),
?RULE(r_constant_propagation), ?RULE(r_constant_propagation),
?RULE(r_prune_impossible_branches), ?RULE(r_prune_impossible_branches),
@ -1022,12 +1046,13 @@ inline_push(Ann1, Arg, Stack, [{i, Ann2, I} = AI | Code], Acc) ->
{As0, As1} = split_stack_arg(Stack, As), {As0, As1} = split_stack_arg(Stack, As),
Acc1 = [{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As0 ++ [Arg] ++ As1)} | Acc], Acc1 = [{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As0 ++ [Arg] ++ As1)} | Acc],
{lists:reverse(Acc1), Code}; {lists:reverse(Acc1), Code};
false -> false when Arg /= R ->
{AI1, {i, Ann1b, _}} = swap_instrs({i, Ann1, {'STORE', ?a, Arg}}, AI), {AI1, {i, Ann1b, _}} = swap_instrs({i, Ann1, {'STORE', ?a, Arg}}, AI),
inline_push(Ann1b, Arg, Stack + Produces - Consumes, Code, [AI1 | Acc]) inline_push(Ann1b, Arg, Stack + Produces - Consumes, Code, [AI1 | Acc]);
end;
false -> false false -> false
end; end;
_ -> false
end;
inline_push(_, _, _, _, _) -> false. inline_push(_, _, _, _, _) -> false.
split_stack_arg(N, As) -> split_stack_arg(N, As, []). split_stack_arg(N, As) -> split_stack_arg(N, As, []).
@ -1038,16 +1063,42 @@ split_stack_arg(N, [A | As], Acc) ->
true -> N end, true -> N end,
split_stack_arg(N1, As, [A | Acc]). split_stack_arg(N1, As, [A | Acc]).
%% Move PUSH A past non-stack instructions. %% Move PUSHes past non-stack instructions.
r_swap_push(Push = {i, _, {'STORE', ?a, _}}, [I | Code]) -> r_swap_push(Push = {i, _, PushI}, [I | Code]) ->
case op_view(PushI) of
{_, ?a, _} ->
case independent(Push, I) of case independent(Push, I) of
true -> true ->
{I1, Push1} = swap_instrs(Push, I), {I1, Push1} = swap_instrs(Push, I),
{[I1, Push1], Code}; {[I1, Push1], Code};
false -> false false -> false
end; end;
_ -> false
end;
r_swap_push(_, _) -> false. r_swap_push(_, _) -> false.
%% Move non-stack instruction past POPs.
r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
case independent(IA, JA) of
true ->
case {op_view(I), op_view(J)} of
{false, _} -> false;
{_, false} -> false;
{{_, IR, IAs}, {_, RJ, JAs}} ->
NonStackI = not lists:member(?a, [IR | IAs]),
%% RJ /= ?a to not conflict with r_swap_push
PopJ = RJ /= ?a andalso lists:member(?a, JAs),
case NonStackI andalso PopJ of
false -> false;
true ->
{JA1, IA1} = swap_instrs(IA, JA),
{[JA1, IA1], Code}
end
end;
false -> false
end;
r_swap_pop(_, _) -> false.
%% Match up writes to variables with instructions further down. %% Match up writes to variables with instructions further down.
r_swap_write(I = {i, _, _}, [J | Code]) -> r_swap_write(I = {i, _, _}, [J | Code]) ->
case {var_writes(I), independent(I, J)} of case {var_writes(I), independent(I, J)} of
@ -1183,6 +1234,8 @@ r_float_switch_body(I = {i, _, _}, [switch_body | Code]) ->
r_float_switch_body(_, _) -> false. r_float_switch_body(_, _) -> false.
%% Inline stores %% Inline stores
r_inline_store({i, _, {'STORE', R, R}}, Code) ->
{[], Code};
r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) -> r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
%% Not when A is var unless updating the annotations properly. %% Not when A is var unless updating the annotations properly.
Inline = case A of Inline = case A of
@ -1276,7 +1329,11 @@ unannotate({i, _Ann, I}) -> [I].
%% Desugar and specialize %% Desugar and specialize
desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_ops:inc()]; desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_ops:inc()];
desugar({'ADD', A, ?i(1), A}) -> [aeb_fate_ops:inc(A)];
desugar({'ADD', ?a, ?a, ?i(1)}) -> [aeb_fate_ops:inc()];
desugar({'ADD', A, A, ?i(1)}) -> [aeb_fate_ops:inc(A)];
desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_ops:dec()]; desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_ops:dec()];
desugar({'SUB', A, A, ?i(1)}) -> [aeb_fate_ops:dec(A)];
desugar({'STORE', ?a, A}) -> [aeb_fate_ops:push(A)]; desugar({'STORE', ?a, A}) -> [aeb_fate_ops:push(A)];
desugar({switch, Arg, Type, Alts, Def}) -> desugar({switch, Arg, Type, Alts, Def}) ->
[{switch, Arg, Type, [desugar(A) || A <- Alts], desugar(Def)}]; [{switch, Arg, Type, [desugar(A) || A <- Alts], desugar(Def)}];
@ -1477,7 +1534,8 @@ split_calls(Ref, [], Acc, Blocks) ->
split_calls(Ref, [I | Code], Acc, Blocks) when element(1, I) == 'CALL'; split_calls(Ref, [I | Code], Acc, Blocks) when element(1, I) == 'CALL';
element(1, I) == 'CALL_R'; element(1, I) == 'CALL_R';
element(1, I) == 'CALL_GR'; element(1, I) == 'CALL_GR';
element(1, I) == 'jumpif' -> element(1, I) == 'jumpif';
I == loop ->
split_calls(make_ref(), Code, [], [{Ref, lists:reverse([I | Acc])} | Blocks]); split_calls(make_ref(), Code, [], [{Ref, lists:reverse([I | Acc])} | Blocks]);
split_calls(Ref, [{'ABORT', _} = I | _Code], Acc, Blocks) -> split_calls(Ref, [{'ABORT', _} = I | _Code], Acc, Blocks) ->
lists:reverse([{Ref, lists:reverse([I | Acc])} | Blocks]); lists:reverse([{Ref, lists:reverse([I | Acc])} | Blocks]);
@ -1490,6 +1548,7 @@ split_calls(Ref, [I | Code], Acc, Blocks) ->
set_labels(Labels, {Ref, Code}) when is_reference(Ref) -> set_labels(Labels, {Ref, Code}) when is_reference(Ref) ->
{maps:get(Ref, Labels), [ set_labels(Labels, I) || I <- Code ]}; {maps:get(Ref, Labels), [ set_labels(Labels, I) || I <- Code ]};
set_labels(_Labels, loop) -> aeb_fate_ops:jump(0);
set_labels(Labels, {jump, Ref}) -> aeb_fate_ops:jump(maps:get(Ref, Labels)); set_labels(Labels, {jump, Ref}) -> aeb_fate_ops:jump(maps:get(Ref, Labels));
set_labels(Labels, {jumpif, Arg, Ref}) -> aeb_fate_ops:jumpif(Arg, maps:get(Ref, Labels)); set_labels(Labels, {jumpif, Arg, Ref}) -> aeb_fate_ops:jumpif(Arg, maps:get(Ref, Labels));
set_labels(Labels, {switch, Arg, Refs}) -> set_labels(Labels, {switch, Arg, Refs}) ->
@ -1505,3 +1564,10 @@ set_labels(_, I) -> I.
with_ixs(Xs) -> with_ixs(Xs) ->
lists:zip(lists:seq(0, length(Xs) - 1), Xs). lists:zip(lists:seq(0, length(Xs) - 1), Xs).
drop_common_suffix(Xs, Ys) ->
drop_common_suffix_r(lists:reverse(Xs), lists:reverse(Ys)).
drop_common_suffix_r([X | Xs], [X | Ys]) ->
drop_common_suffix_r(Xs, Ys);
drop_common_suffix_r(Xs, Ys) ->
{lists:reverse(Xs), lists:reverse(Ys)}.

1
src/aeso_icode.erl
View File

@ -78,6 +78,7 @@ builtin_types() ->
, "string" => fun([]) -> string end , "string" => fun([]) -> string end
, "address" => Word , "address" => Word
, "hash" => Word , "hash" => Word
, "unit" => fun([]) -> {tuple, []} end
, "signature" => fun([]) -> {tuple, [word, word]} end , "signature" => fun([]) -> {tuple, [word, word]} end
, "oracle" => fun([_, _]) -> word end , "oracle" => fun([_, _]) -> word end
, "oracle_query" => fun([_, _]) -> word end , "oracle_query" => fun([_, _]) -> word end

50
src/aeso_parser.erl
View File

@ -150,7 +150,7 @@ type() -> ?LAZY_P(type100()).
type100() -> type200(). type100() -> type200().
type200() -> type200() ->
?RULE(many({fun_domain(), keyword('=>')}), type300(), fun_t(_1, _2)). ?RULE(many({type300(), keyword('=>')}), type300(), fun_t(_1, _2)).
type300() -> type300() ->
?RULE(sep1(type400(), tok('*')), tuple_t(get_ann(lists:nth(1, _1)), _1)). ?RULE(sep1(type400(), tok('*')), tuple_t(get_ann(lists:nth(1, _1)), _1)).
@ -169,16 +169,15 @@ type400() ->
typeAtom() -> typeAtom() ->
?LAZY_P(choice( ?LAZY_P(choice(
[ parens(type()) [ parens(type())
, args_t()
, id(), token(con), token(qcon), token(qid), tvar() , id(), token(con), token(qcon), token(qid), tvar()
])). ])).
fun_domain() -> ?LAZY_P(choice( args_t() ->
[ ?RULE(tok('('), tok(')'), []) ?LAZY_P(choice(
%% Note avoidance of ambiguity: `(int)` can be treated as: [ ?RULE(tok('('), tok(')'), {args_t, get_ann(_1), []})
%% - literally `int` %% Singleton case handled separately
%% - list of arguments with just one element – int. This approach is dropped. , ?RULE(tok('('), type(), tok(','), sep1(type(), tok(',')), tok(')'), {args_t, get_ann(_1), [_2|_4]})
, ?RULE(tok('('), type(), tok(','), sep1(type(), tok(',')), tok(')'), [_2|_4])
, ?RULE(type300(), [_1])
])). ])).
%% -- Statements ------------------------------------------------------------- %% -- Statements -------------------------------------------------------------
@ -501,7 +500,8 @@ tuple_t(_Ann, [Type]) -> Type; %% Not a tuple
tuple_t(Ann, Types) -> {tuple_t, Ann, Types}. tuple_t(Ann, Types) -> {tuple_t, Ann, Types}.
fun_t(Domains, Type) -> fun_t(Domains, Type) ->
lists:foldr(fun({Dom, Ann}, T) -> {fun_t, Ann, [], Dom, T} end, lists:foldr(fun({{args_t, _, Dom}, Ann}, T) -> {fun_t, Ann, [], Dom, T};
({Dom, Ann}, T) -> {fun_t, Ann, [], [Dom], T} end,
Type, Domains). Type, Domains).
tuple_e(_Ann, [Expr]) -> Expr; %% Not a tuple tuple_e(_Ann, [Expr]) -> Expr; %% Not a tuple
@ -549,12 +549,16 @@ bad_expr_err(Reason, E) ->
prettypr:nest(2, aeso_pretty:expr(E))])). prettypr:nest(2, aeso_pretty:expr(E))])).
%% -- Helper functions ------------------------------------------------------- %% -- Helper functions -------------------------------------------------------
expand_includes(AST, Included, Opts) -> expand_includes(AST, Included, Opts) ->
expand_includes(AST, Included, [], Opts). Ann = [{origin, system}],
AST1 = [ {include, Ann, {string, Ann, File}}
|| File <- lists:usort(auto_imports(AST)) ] ++ AST,
expand_includes(AST1, Included, [], Opts).
expand_includes([], _Included, Acc, _Opts) -> expand_includes([], _Included, Acc, _Opts) ->
{ok, lists:reverse(Acc)}; {ok, lists:reverse(Acc)};
expand_includes([{include, Ann, {string, SAnn, File}} | AST], Included, Acc, Opts) -> expand_includes([{include, Ann, {string, _SAnn, File}} | AST], Included, Acc, Opts) ->
case get_include_code(File, Ann, Opts) of case get_include_code(File, Ann, Opts) of
{ok, Code} -> {ok, Code} ->
Hashed = hash_include(File, Code), Hashed = hash_include(File, Code),
@ -562,12 +566,9 @@ expand_includes([{include, Ann, {string, SAnn, File}} | AST], Included, Acc, Opt
false -> false ->
Opts1 = lists:keystore(src_file, 1, Opts, {src_file, File}), Opts1 = lists:keystore(src_file, 1, Opts, {src_file, File}),
Included1 = sets:add_element(Hashed, Included), Included1 = sets:add_element(Hashed, Included),
case string(Code, Included1, Opts1) of case parse_and_scan(file(), Code, Opts1) of
{ok, AST1} -> {ok, AST1} ->
Dependencies = [ {include, Ann, {string, SAnn, Dep}} expand_includes(AST1 ++ AST, Included1, Acc, Opts);
|| Dep <- aeso_stdlib:dependencies(File)
],
expand_includes(Dependencies ++ AST1 ++ AST, Included1, Acc, Opts);
Err = {error, _} -> Err = {error, _} ->
Err Err
end; end;
@ -593,12 +594,15 @@ read_file(File, Opts) ->
end end
end. end.
stdlib_options() ->
[{include, {file_system, [aeso_stdlib:stdlib_include_path()]}}].
get_include_code(File, Ann, Opts) -> get_include_code(File, Ann, Opts) ->
case {read_file(File, Opts), maps:find(File, aeso_stdlib:stdlib())} of case {read_file(File, Opts), read_file(File, stdlib_options())} of
{{ok, _}, {ok,_ }} -> {{ok, _}, {ok,_ }} ->
return_error(ann_pos(Ann), "Illegal redefinition of standard library " ++ File); return_error(ann_pos(Ann), "Illegal redefinition of standard library " ++ File);
{_, {ok, Lib}} -> {_, {ok, Bin}} ->
{ok, Lib}; {ok, binary_to_list(Bin)};
{{ok, Bin}, _} -> {{ok, Bin}, _} ->
{ok, binary_to_list(Bin)}; {ok, binary_to_list(Bin)};
{_, _} -> {_, _} ->
@ -610,3 +614,11 @@ hash_include(File, Code) when is_binary(File) ->
hash_include(binary_to_list(File), Code); hash_include(binary_to_list(File), Code);
hash_include(File, Code) when is_list(File) -> hash_include(File, Code) when is_list(File) ->
{filename:basename(File), crypto:hash(sha256, Code)}. {filename:basename(File), crypto:hash(sha256, Code)}.
auto_imports({comprehension_bind, _, _}) -> [<<"ListInternal.aes">>];
auto_imports({'..', _}) -> [<<"ListInternal.aes">>];
auto_imports(L) when is_list(L) ->
lists:flatmap(fun auto_imports/1, L);
auto_imports(T) when is_tuple(T) ->
auto_imports(tuple_to_list(T));
auto_imports(_) -> [].

2
src/aeso_pretty.erl
View File

@ -243,6 +243,8 @@ type({app_t, _, Type, Args}) ->
beside(type(Type), args_type(Args)); beside(type(Type), args_type(Args));
type({tuple_t, _, Args}) -> type({tuple_t, _, Args}) ->
tuple_type(Args); tuple_type(Args);
type({args_t, _, Args}) ->
args_type(Args);
type({bytes_t, _, any}) -> text("bytes(_)"); type({bytes_t, _, any}) -> text("bytes(_)");
type({bytes_t, _, Len}) -> type({bytes_t, _, Len}) ->
text(lists:concat(["bytes(", Len, ")"])); text(lists:concat(["bytes(", Len, ")"]));

423
src/aeso_stdlib.erl
View File

@ -10,425 +10,8 @@
-module(aeso_stdlib). -module(aeso_stdlib).
-export([stdlib/0, stdlib_list/0, dependencies/1]). -export([stdlib_include_path/0]).
stdlib() -> stdlib_include_path() ->
maps:from_list(stdlib_list()). filename:join([code:priv_dir(aesophia), "stdlib"]).
stdlib_list() ->
[ {<<"List.aes">>, std_list()}
, {<<"Func.aes">>, std_func()}
, {<<"Option.aes">>, std_option()}
, {<<"Pair.aes">>, std_pair()}
, {<<"Triple.aes">>, std_triple()}
].
dependencies(Q) ->
case Q of
<<"Option.aes">> ->
[<<"List.aes">>];
_ -> []
end.
std_func() ->
"
namespace Func =
function id(x : 'a) : 'a = x
function const(x : 'a) : 'b => 'a = (y) => x
function flip(f : ('a, 'b) => 'c) : ('b, 'a) => 'c = (b, a) => f(a, b)
function comp(f : 'b => 'c, g : 'a => 'b) : 'a => 'c = (x) => f(g(x))
function pipe(f : 'a => 'b, g : 'b => 'c) : 'a => 'c = (x) => g(f(x))
function rapply(x : 'a, f : 'a => 'b) : 'b = f(x)
/* The Z combinator - replacement for local and anonymous recursion.
*/
function recur(f : ('arg => 'res, 'arg) => 'res) : 'arg => 'res =
(x) => f(recur(f), x)
function iter(n : int, f : 'a => 'a) : 'a => 'a = iter_(n, f, (x) => x)
private function iter_(n : int, f : 'a => 'a, acc : 'a => 'a) : 'a => 'a =
if(n == 0) acc
elif(n == 1) comp(f, acc)
else iter_(n / 2, comp(f, f), if(n mod 2 == 0) acc else comp(f, acc))
function curry2(f : ('a, 'b) => 'c) : 'a => ('b => 'c) =
(x) => (y) => f(x, y)
function curry3(f : ('a, 'b, 'c) => 'd) : 'a => ('b => ('c => 'd)) =
(x) => (y) => (z) => f(x, y, z)
function uncurry2(f : 'a => ('b => 'c)) : ('a, 'b) => 'c =
(x, y) => f(x)(y)
function uncurry3(f : 'a => ('b => ('c => 'd))) : ('a, 'b, 'c) => 'd =
(x, y, z) => f(x)(y)(z)
function tuplify2(f : ('a, 'b) => 'c) : (('a * 'b)) => 'c =
(t) => switch(t)
(x, y) => f(x, y)
function tuplify3(f : ('a, 'b, 'c) => 'd) : 'a * 'b * 'c => 'd =
(t) => switch(t)
(x, y, z) => f(x, y, z)
function untuplify2(f : 'a * 'b => 'c) : ('a, 'b) => 'c =
(x, y) => f((x, y))
function untuplify3(f : 'a * 'b * 'c => 'd) : ('a, 'b, 'c) => 'd =
(x, y, z) => f((x, y, z))
".
std_list() ->"
namespace List =
function is_empty(l : list('a)) : bool = switch(l)
[] => true
_ => false
function first(l : list('a)) : option('a) = switch(l)
[] => None
h::_ => Some(h)
function tail(l : list('a)) : option(list('a)) = switch(l)
[] => None
_::t => Some(t)
function last(l : list('a)) : option('a) = switch(l)
[] => None
[x] => Some(x)
_::t => last(t)
function find(p : 'a => bool, l : list('a)) : option('a) = switch(l)
[] => None
h::t => if(p(h)) Some(h) else find(p, t)
function find_all(p : 'a => bool, l : list('a)) : list('a) = find_all_(p, l, [])
private function find_all_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => find_all_(p, t, if(p(h)) h::acc else acc)
function find_indices(p : 'a => bool, l : list('a)) : list(int) = find_indices_(p, l, 0, [])
private function find_indices_( p : 'a => bool
, l : list('a)
, n : int
, acc : list(int)
) : list(int) = switch(l)
[] => reverse(acc)
h::t => find_indices_(p, t, n+1, if(p(h)) n::acc else acc)
function nth(n : int, l : list('a)) : option('a) = switch(l)
[] => None
h::t => if(n == 0) Some(h) else nth(n-1, t)
/* Unsafe version of `nth` */
function get(n : int, l : list('a)) : 'a = switch(l)
[] => abort(\"Out of index get\")
h::t => if(n == 0) h else get(n-1, t)
function length(l : list('a)) : int = length_(l, 0)
private function length_(l : list('a), acc : int) : int = switch(l)
[] => acc
_::t => length_(t, acc + 1)
/* Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow */
function replace_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort(\"insert_at underflow\") else replace_at_(n, e, l, [])
private function replace_at_(n : int, e : 'a, l : list('a), acc : list('a)) : list('a) =
switch(l)
[] => abort(\"replace_at overflow\")
h::t => if (n == 0) reverse(e::acc) ++ t
else replace_at_(n-1, e, t, h::acc)
/* Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow */
function insert_at(n : int, e : 'a, l : list('a)) : list('a) =
if(n<0) abort(\"insert_at underflow\") else insert_at_(n, e, l, [])
private function insert_at_(n : int, e : 'a, l : list('a), acc : list('a)) : list('a) =
if (n == 0) reverse(e::acc) ++ l
else switch(l)
[] => abort(\"insert_at overflow\")
h::t => insert_at_(n-1, e, t, h::acc)
function insert_by(f : (('a, 'a) => bool), x : 'a, l : list('a)) : list('a) =
switch(l)
[] => [x]
(e :: l') =>
if(f(x, e))
e :: insert_by(f, x, l')
else
x :: l
function foldr(cons : ('a, 'b) => 'b, nil : 'b, l : list('a)) : 'b = switch(l)
[] => nil
h::t => cons(h, foldr(cons, nil, t))
function foldl(rcons : ('b, 'a) => 'b, acc : 'b, l : list('a)) : 'b = switch(l)
[] => acc
h::t => foldl(rcons, rcons(acc, h), t)
function foreach(f : 'a => unit, l : list('a)) : unit =
switch(l)
[] => ()
e :: l' =>
f(e)
foreach(f, l')
function reverse(l : list('a)) : list('a) = foldl((lst, el) => el :: lst, [], l)
function map(f : 'a => 'b, l : list('a)) : list('b) = map_(f, l, [])
private function map_(f : 'a => 'b, l : list('a), acc : list('b)) : list('b) = switch(l)
[] => reverse(acc)
h::t => map_(f, t, f(h)::acc)
function flat_map(f : 'a => list('b), l : list('a)) : list('b) = flat_map_(f, l, [])
private function flat_map_(f : 'a => list('b), l : list('a), acc : list('b)) : list('b) = switch(l)
[] => reverse(acc)
h::t => flat_map_(f, t, reverse(f(h)) ++ acc)
function filter(p : 'a => bool, l : list('a)) : list('a) = filter_(p, l, [])
private function filter_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => filter_(p, t, if(p(h)) h::acc else acc)
/* Take `n` first elements */
function take(n : int, l : list('a)) : list('a) =
if(n < 0) abort(\"Take negative number of elements\") else take_(n, l, [])
private function take_(n : int, l : list('a), acc : list('a)) : list('a) =
if(n == 0) reverse(acc)
else switch(l)
[] => reverse(acc)
h::t => take_(n-1, t, h::acc)
/* Drop `n` first elements */
function drop(n : int, l : list('a)) : list('a) =
if(n < 0) abort(\"Drop negative number of elements\")
elif (n == 0) l
else switch(l)
[] => []
h::t => drop(n-1, t)
/* Get the longest prefix of a list in which every element matches predicate `p` */
function take_while(p : 'a => bool, l : list('a)) : list('a) = take_while_(p, l, [])
private function take_while_(p : 'a => bool, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
h::t => if(p(h)) take_while_(p, t, h::acc) else reverse(acc)
/* Drop elements from `l` until `p` holds */
function drop_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => if(p(h)) drop_while(p, t) else l
/* Splits list into two lists of elements that respectively match and don't match predicate `p` */
function partition(p : 'a => bool, l : list('a)) : (list('a) * list('a)) = partition_(p, l, [], [])
private function partition_( p : 'a => bool
, l : list('a)
, acc_t : list('a)
, acc_f : list('a)
) : (list('a) * list('a)) = switch(l)
[] => (reverse(acc_t), reverse(acc_f))
h::t => if(p(h)) partition_(p, t, h::acc_t, acc_f) else partition_(p, t, acc_t, h::acc_f)
function concats(ll : list(list('a))) : list('a) = foldr((l1, l2) => l1 ++ l2, [], ll)
function all(p : 'a => bool, l : list('a)) : bool = switch(l)
[] => true
h::t => if(p(h)) all(p, t) else false
function any(p : 'a => bool, l : list('a)) : bool = switch(l)
[] => false
h::t => if(p(h)) true else any(p, t)
function sum(l : list(int)) : int = foldl ((a, b) => a + b, 0, l)
function product(l : list(int)) : int = foldl((a, b) => a * b, 1, l)
/* Zips two list by applying bimapping function on respective elements. Drops longer tail. */
function zip_with(f : ('a, 'b) => 'c, l1 : list('a), l2 : list('b)) : list('c) = zip_with_(f, l1, l2, [])
private function zip_with_( f : ('a, 'b) => 'c
, l1 : list('a)
, l2 : list('b)
, acc : list('c)
) : list('c) = switch ((l1, l2))
(h1::t1, h2::t2) => zip_with_(f, t1, t2, f(h1, h2)::acc)
_ => reverse(acc)
/* Zips two lists into list of pairs. Drops longer tail. */
function zip(l1 : list('a), l2 : list('b)) : list('a * 'b) = zip_with((a, b) => (a, b), l1, l2)
function unzip(l : list('a * 'b)) : list('a) * list('b) = unzip_(l, [], [])
private function unzip_( l : list('a * 'b)
, acc_l : list('a)
, acc_r : list('b)
) : (list('a) * list('b)) = switch(l)
[] => (reverse(acc_l), reverse(acc_r))
(left, right)::t => unzip_(t, left::acc_l, right::acc_r)
// TODO: Improve?
function sort(lesser_cmp : ('a, 'a) => bool, l : list('a)) : list('a) = switch(l)
[] => []
h::t => switch (partition((x) => lesser_cmp(x, h), t))
(lesser, bigger) => sort(lesser_cmp, lesser) ++ h::sort(lesser_cmp, bigger)
function intersperse(delim : 'a, l : list('a)) : list('a) = intersperse_(delim, l, [])
private function intersperse_(delim : 'a, l : list('a), acc : list('a)) : list('a) = switch(l)
[] => reverse(acc)
[e] => reverse(e::acc)
h::t => intersperse_(delim, t, delim::h::acc)
function enumerate(l : list('a)) : list(int * 'a) = enumerate_(l, 0, [])
private function enumerate_(l : list('a), n : int, acc : list(int * 'a)) : list(int * 'a) = switch(l)
[] => reverse(acc)
h::t => enumerate_(t, n + 1, (n, h)::acc)
".
std_option() -> "
namespace Option =
function is_none(o : option('a)) : bool = switch(o)
None => true
Some(_) => false
function is_some(o : option('a)) : bool = switch(o)
None => false
Some(_) => true
function match(n : 'b, s : 'a => 'b, o : option('a)) : 'b = switch(o)
None => n
Some(x) => s(x)
function default(def : 'a, o : option('a)) : 'a = match(def, (x) => x, o)
function force(o : option('a)) : 'a = default(abort(\"Forced None value\"), o)
function on_elem(f : 'a => unit, o : option('a)) : unit = match((), f, o)
function map(f : 'a => 'b, o : option('a)) : option('b) = switch(o)
None => None
Some(x) => Some(f(x))
function map2(f : ('a, 'b) => 'c
, o1 : option('a)
, o2 : option('b)
) : option('c) = switch((o1, o2))
(Some(x1), Some(x2)) => Some(f(x1, x2))
_ => None
function map3( f : ('a, 'b, 'c) => 'd
, o1 : option('a)
, o2 : option('b)
, o3 : option('c)
) : option('d) = switch((o1, o2, o3))
(Some(x1), Some(x2), Some(x3)) => Some(f(x1, x2, x3))
_ => None
function app_over(f : option ('a => 'b), o : option('a)) : option('b) = switch((f, o))
(Some(ff), Some(xx)) => Some(ff(xx))
_ => None
function flat_map(f : 'a => option('b), o : option('a)) : option('b) = switch(o)
None => None
Some(x) => f(x)
function to_list(o : option('a)) : list('a) = switch(o)
None => []
Some(x) => [x]
function filter_options(l : list(option('a))) : list('a) = filter_options_(l, [])
private function filter_options_(l : list (option('a)), acc : list('a)) : list('a) = switch(l)
[] => List.reverse(acc)
None::t => filter_options_(t, acc)
Some(x)::t => filter_options_(t, x::acc)
function seq_options(l : list (option('a))) : option (list('a)) = seq_options_(l, [])
private function seq_options_(l : list (option('a)), acc : list('a)) : option(list('a)) = switch(l)
[] => Some(List.reverse(acc))
None::t => None
Some(x)::t => seq_options_(t, x::acc)
function choose(o1 : option('a), o2 : option('a)) : option('a) =
if(is_some(o1)) o1 else o2
function choose_first(l : list(option('a))) : option('a) = switch(l)
[] => None
None::t => choose_first(t)
Some(x)::_ => Some(x)
".
std_pair() -> "
namespace Pair =
function fst(t : ('a * 'b)) : 'a = switch(t)
(x, _) => x
function snd(t : ('a * 'b)) : 'b = switch(t)
(_, y) => y
function map1(f : 'a => 'c, t : ('a * 'b)) : ('c * 'b) = switch(t)
(x, y) => (f(x), y)
function map2(f : 'b => 'c, t : ('a * 'b)) : ('a * 'c) = switch(t)
(x, y) => (x, f(y))
function bimap(f : 'a => 'c, g : 'b => 'd, t : ('a * 'b)) : ('c * 'd) = switch(t)
(x, y) => (f(x), g(y))
function swap(t : ('a * 'b)) : ('b * 'a) = switch(t)
(x, y) => (y, x)
".
std_triple() -> "
namespace Triple =
function fst(t : ('a * 'b * 'c)) : 'a = switch(t)
(x, _, _) => x
function snd(t : ('a * 'b * 'c)) : 'b = switch(t)
(_, y, _) => y
function thd(t : ('a * 'b * 'c)) : 'c = switch(t)
(_, _, z) => z
function map1(f : 'a => 'm, t : ('a * 'b * 'c)) : ('m * 'b * 'c) = switch(t)
(x, y, z) => (f(x), y, z)
function map2(f : 'b => 'm, t : ('a * 'b * 'c)) : ('a * 'm * 'c) = switch(t)
(x, y, z) => (x, f(y), z)
function map3(f : 'c => 'm, t : ('a * 'b * 'c)) : ('a * 'b * 'm) = switch(t)
(x, y, z) => (x, y, f(z))
function trimap( f : 'a => 'x
, g : 'b => 'y
, h : 'c => 'z
, t : ('a * 'b * 'c)
) : ('x * 'y * 'z) = switch(t)
(x, y, z) => (f(x), g(y), h(z))
function swap(t : ('a * 'b * 'c)) : ('c * 'b * 'a) = switch(t)
(x, y, z) => (z, y, x)
function rotr(t : ('a * 'b * 'c)) : ('c * 'a * 'b) = switch(t)
(x, y, z) => (z, x, y)
function rotl(t : ('a * 'b * 'c)) : ('b * 'c * 'a) = switch(t)
(x, y, z) => (y, z, x)
".

5
src/aeso_syntax.erl
View File

@ -59,6 +59,7 @@
-type type() :: {fun_t, ann(), [named_arg_t()], [type()], type()} -type type() :: {fun_t, ann(), [named_arg_t()], [type()], type()}
| {app_t, ann(), type(), [type()]} | {app_t, ann(), type(), [type()]}
| {tuple_t, ann(), [type()]} | {tuple_t, ann(), [type()]}
| {args_t, ann(), [type()]} %% old tuple syntax, old for error messages
| {bytes_t, ann(), integer() | any} | {bytes_t, ann(), integer() | any}
| id() | qid() | id() | qid()
| con() | qcon() %% contracts | con() | qcon() %% contracts
@ -105,8 +106,8 @@
| id() | qid() | con() | qcon() | id() | qid() | con() | qcon()
| constant(). | constant().
-type comprehension_exp() :: [{ comprehension_bind, ann(), id(), expr()} -type comprehension_exp() :: [ {comprehension_bind, id(), expr()}
| {comprehension_if, expr()} | {comprehension_if, ann(), expr()}
| letbind() ]. | letbind() ].
-type arg_expr() :: expr() | {named_arg, ann(), id(), expr()}. -type arg_expr() :: expr() | {named_arg, ann(), id(), expr()}.

14
src/aeso_syntax_utils.erl
View File

@ -49,7 +49,7 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
{type_def, _, I, _, D} -> Plus(BindType(I), Decl(D)); {type_def, _, I, _, D} -> Plus(BindType(I), Decl(D));
{fun_decl, _, _, T} -> Type(T); {fun_decl, _, _, T} -> Type(T);
{letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]); {letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]);
{letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Scoped(BindExpr(Xs), Expr(E))]); {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]);
%% typedef() %% typedef()
{alias_t, T} -> Type(T); {alias_t, T} -> Type(T);
{record_t, Fs} -> Type(Fs); {record_t, Fs} -> Type(Fs);
@ -74,7 +74,7 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
{list_comp, _, Y, []} -> Expr(Y); {list_comp, _, Y, []} -> Expr(Y);
{list_comp, A, Y, [{comprehension_bind, I, E}|R]} -> {list_comp, A, Y, [{comprehension_bind, I, E}|R]} ->
Plus(Expr(E), Scoped(BindExpr(I), Expr({list_comp, A, Y, R}))); Plus(Expr(E), Scoped(BindExpr(I), Expr({list_comp, A, Y, R})));
{list_comp, A, Y, [{comprehension_if, E}|R]} -> {list_comp, A, Y, [{comprehension_if, _, E}|R]} ->
Plus(Expr(E), Expr({list_comp, A, Y, R})); Plus(Expr(E), Expr({list_comp, A, Y, R}));
{list_comp, A, Y, [D = {letval, _, F, _, _} | R]} -> {list_comp, A, Y, [D = {letval, _, F, _, _} | R]} ->
Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R}))); Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R})));
@ -92,7 +92,7 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
{field, _, LV, E} -> Expr([LV, E]); {field, _, LV, E} -> Expr([LV, E]);
{field, _, LV, _, E} -> Expr([LV, E]); {field, _, LV, _, E} -> Expr([LV, E]);
%% arg() %% arg()
{arg, _, X, T} -> Plus(Expr(X), Type(T)); {arg, _, Y, T} -> Plus(BindExpr(Y), Type(T));
%% alt() %% alt()
{'case', _, P, E} -> Scoped(BindExpr(P), Expr(E)); {'case', _, P, E} -> Scoped(BindExpr(P), Expr(E));
%% elim() %% elim()
@ -124,12 +124,12 @@ used_types([Top] = _CurrentNS, T) ->
entity_alg() -> entity_alg() ->
IsBound = fun({K, _}) -> lists:member(K, [bound_term, bound_type]) end, IsBound = fun({K, _}) -> lists:member(K, [bound_term, bound_type]) end,
Unbind = fun(bound_term) -> term; (bound_type) -> type end, Unbind = fun(bound_term) -> term; (bound_type) -> type end,
Remove = fun(Keys, Map) -> lists:foldl(fun maps:remove/2, Map, Keys) end, Remove = fun(Keys, Map) -> maps:without(Keys, Map) end,
Scoped = fun(Xs, Ys) -> Scoped = fun(Xs, Ys) ->
Bound = [E || E <- maps:keys(Ys), IsBound(E)], Bound = [E || E <- maps:keys(Xs), IsBound(E)],
Others = Remove(Bound, Ys),
Bound1 = [ {Unbind(Tag), X} || {Tag, X} <- Bound ], Bound1 = [ {Unbind(Tag), X} || {Tag, X} <- Bound ],
maps:merge(Remove(Bound1, Xs), Others) Others = Remove(Bound1, Ys),
maps:merge(Remove(Bound, Xs), Others)
end, end,
#alg{ zero = #{} #alg{ zero = #{}
, plus = fun maps:merge/2 , plus = fun maps:merge/2

2
src/aesophia.app.src
View File

@ -1,6 +1,6 @@
{application, aesophia, {application, aesophia,
[{description, "Contract Language for aeternity"}, [{description, "Contract Language for aeternity"},
{vsn, "3.2.0"}, {vsn, "4.0.0-rc1"},
{registered, []}, {registered, []},
{applications, {applications,
[kernel, [kernel,

14
test/aeso_abi_tests.erl
View File

@ -80,11 +80,11 @@ encode_decode_sophia_string(SophiaType, String) ->
, " record r = {x : an_alias(int), y : variant}\n" , " record r = {x : an_alias(int), y : variant}\n"
, " datatype variant = Red | Blue(map(string, int))\n" , " datatype variant = Red | Blue(map(string, int))\n"
, " entrypoint foo : arg_type => arg_type\n" ], , " entrypoint foo : arg_type => arg_type\n" ],
case aeso_compiler:check_call(lists:flatten(Code), "foo", [String], [no_implicit_stdlib]) of case aeso_compiler:check_call(lists:flatten(Code), "foo", [String], []) of
{ok, _, {[Type], _}, [Arg]} -> {ok, _, {[Type], _}, [Arg]} ->
io:format("Type ~p~n", [Type]), io:format("Type ~p~n", [Type]),
Data = encode(Arg), Data = encode(Arg),
case aeso_compiler:to_sophia_value(Code, "foo", ok, Data, [no_implicit_stdlib]) of case aeso_compiler:to_sophia_value(Code, "foo", ok, Data, []) of
{ok, Sophia} -> {ok, Sophia} ->
lists:flatten(io_lib:format("~s", [prettypr:format(aeso_pretty:expr(Sophia))])); lists:flatten(io_lib:format("~s", [prettypr:format(aeso_pretty:expr(Sophia))]));
{error, Err} -> {error, Err} ->
@ -152,7 +152,7 @@ oracle_test() ->
" Oracle.get_question(o, q)\n", " Oracle.get_question(o, q)\n",
{ok, _, {[word, word], {list, string}}, [16#123, 16#456]} = {ok, _, {[word, word], {list, string}}, [16#123, 16#456]} =
aeso_compiler:check_call(Contract, "question", ["ok_111111111111111111111111111111ZrdqRz9", aeso_compiler:check_call(Contract, "question", ["ok_111111111111111111111111111111ZrdqRz9",
"oq_1111111111111111111111111111113AFEFpt5"], [no_implicit_stdlib]), "oq_1111111111111111111111111111113AFEFpt5"], []),
ok. ok.
@ -162,7 +162,7 @@ permissive_literals_fail_test() ->
" stateful entrypoint haxx(o : oracle(list(string), option(int))) =\n" " stateful entrypoint haxx(o : oracle(list(string), option(int))) =\n"
" Chain.spend(o, 1000000)\n", " Chain.spend(o, 1000000)\n",
{error, <<"Type errors\nCannot unify", _/binary>>} = {error, <<"Type errors\nCannot unify", _/binary>>} =
aeso_compiler:check_call(Contract, "haxx", ["#123"], [no_implicit_stdlib]), aeso_compiler:check_call(Contract, "haxx", ["#123"], []),
ok. ok.
encode_decode_calldata(FunName, Types, Args) -> encode_decode_calldata(FunName, Types, Args) ->
@ -173,8 +173,8 @@ encode_decode_calldata(FunName, Types, Args, RetType) ->
encode_decode_calldata_(Code, FunName, Args, RetType). encode_decode_calldata_(Code, FunName, Args, RetType).
encode_decode_calldata_(Code, FunName, Args, RetVMType) -> encode_decode_calldata_(Code, FunName, Args, RetVMType) ->
{ok, Calldata} = aeso_compiler:create_calldata(Code, FunName, Args, [no_implicit_stdlib]), {ok, Calldata} = aeso_compiler:create_calldata(Code, FunName, Args, []),
{ok, _, {ArgTypes, RetType}, _} = aeso_compiler:check_call(Code, FunName, Args, [{backend, aevm}, no_implicit_stdlib]), {ok, _, {ArgTypes, RetType}, _} = aeso_compiler:check_call(Code, FunName, Args, [{backend, aevm}]),
?assertEqual(RetType, RetVMType), ?assertEqual(RetType, RetVMType),
CalldataType = {tuple, [word, {tuple, ArgTypes}]}, CalldataType = {tuple, [word, {tuple, ArgTypes}]},
{ok, {_Hash, ArgTuple}} = aeb_heap:from_binary(CalldataType, Calldata), {ok, {_Hash, ArgTuple}} = aeb_heap:from_binary(CalldataType, Calldata),
@ -182,7 +182,7 @@ encode_decode_calldata_(Code, FunName, Args, RetVMType) ->
"init" -> "init" ->
ok; ok;
_ -> _ ->
{ok, _ArgTypes, ValueASTs} = aeso_compiler:decode_calldata(Code, FunName, Calldata, [no_implicit_stdlib]), {ok, _ArgTypes, ValueASTs} = aeso_compiler:decode_calldata(Code, FunName, Calldata, []),
Values = [ prettypr:format(aeso_pretty:expr(V)) || V <- ValueASTs ], Values = [ prettypr:format(aeso_pretty:expr(V)) || V <- ValueASTs ],
?assertMatch({X, X}, {Args, Values}) ?assertMatch({X, X}, {Args, Values})
end, end,

5
test/aeso_aci_tests.erl
View File

@ -9,7 +9,7 @@ simple_aci_test_() ->
test_contract(N) -> test_contract(N) ->
{Contract,MapACI,DecACI} = test_cases(N), {Contract,MapACI,DecACI} = test_cases(N),
{ok,JSON} = aeso_aci:contract_interface(json, Contract, [no_implicit_stdlib]), {ok,JSON} = aeso_aci:contract_interface(json, Contract),
?assertEqual([MapACI], JSON), ?assertEqual([MapACI], JSON),
?assertEqual({ok, DecACI}, aeso_aci:render_aci_json(JSON)). ?assertEqual({ok, DecACI}, aeso_aci:render_aci_json(JSON)).
@ -90,8 +90,7 @@ aci_test_() ->
fun() -> aci_test_contract(ContractName) end} fun() -> aci_test_contract(ContractName) end}
|| ContractName <- all_contracts()]. || ContractName <- all_contracts()].
all_contracts() -> [C || C <- aeso_compiler_tests:compilable_contracts() all_contracts() -> aeso_compiler_tests:compilable_contracts().
, not aeso_compiler_tests:wants_stdlib(C)].
aci_test_contract(Name) -> aci_test_contract(Name) ->
String = aeso_test_utils:read_contract(Name), String = aeso_test_utils:read_contract(Name),

12
test/aeso_calldata_tests.erl
View File

@ -21,14 +21,12 @@ calldata_test_() ->
ContractString = aeso_test_utils:read_contract(ContractName), ContractString = aeso_test_utils:read_contract(ContractName),
AevmExprs = AevmExprs =
case not lists:member(ContractName, not_yet_compilable(aevm)) of case not lists:member(ContractName, not_yet_compilable(aevm)) of
true -> ast_exprs(ContractString, Fun, Args, [{backend, aevm}] true -> ast_exprs(ContractString, Fun, Args, [{backend, aevm}]);
++ [no_implicit_stdlib || not aeso_compiler_tests:wants_stdlib(ContractName)]);
false -> undefined false -> undefined
end, end,
FateExprs = FateExprs =
case not lists:member(ContractName, not_yet_compilable(fate)) of case not lists:member(ContractName, not_yet_compilable(fate)) of
true -> ast_exprs(ContractString, Fun, Args, [{backend, fate}] true -> ast_exprs(ContractString, Fun, Args, [{backend, fate}]);
++ [no_implicit_stdlib || not aeso_compiler_tests:wants_stdlib(ContractName)]);
false -> undefined false -> undefined
end, end,
case FateExprs == undefined orelse AevmExprs == undefined of case FateExprs == undefined orelse AevmExprs == undefined of
@ -47,14 +45,12 @@ calldata_aci_test_() ->
io:format("ACI:\n~s\n", [ContractACIBin]), io:format("ACI:\n~s\n", [ContractACIBin]),
AevmExprs = AevmExprs =
case not lists:member(ContractName, not_yet_compilable(aevm)) of case not lists:member(ContractName, not_yet_compilable(aevm)) of
true -> ast_exprs(ContractACI, Fun, Args, [{backend, aevm}] true -> ast_exprs(ContractACI, Fun, Args, [{backend, aevm}]);
++ [no_implicit_stdlib || not aeso_compiler_tests:wants_stdlib(ContractName)]);
false -> undefined false -> undefined
end, end,
FateExprs = FateExprs =
case not lists:member(ContractName, not_yet_compilable(fate)) of case not lists:member(ContractName, not_yet_compilable(fate)) of
true -> ast_exprs(ContractACI, Fun, Args, [{backend, fate}] true -> ast_exprs(ContractACI, Fun, Args, [{backend, fate}]);
++ [no_implicit_stdlib || not aeso_compiler_tests:wants_stdlib(ContractName)]);
false -> undefined false -> undefined
end, end,
case FateExprs == undefined orelse AevmExprs == undefined of case FateExprs == undefined orelse AevmExprs == undefined of

24
test/aeso_compiler_tests.erl
View File

@ -53,15 +53,17 @@ simple_compile_test_() ->
#{byte_code := Code2} = compile(aevm, "include"), #{byte_code := Code2} = compile(aevm, "include"),
?assertMatch(true, Code1 == Code2) ?assertMatch(true, Code1 == Code2)
end} ] ++ end} ] ++
[ {"Testing deadcode elimination", [ {"Testing deadcode elimination for " ++ atom_to_list(Backend),
fun() -> fun() ->
#{ byte_code := NoDeadCode } = compile(aevm, "nodeadcode"), #{ byte_code := NoDeadCode } = compile(Backend, "nodeadcode"),
#{ byte_code := DeadCode } = compile(aevm, "deadcode"), #{ byte_code := DeadCode } = compile(Backend, "deadcode"),
SizeNoDeadCode = byte_size(NoDeadCode), SizeNoDeadCode = byte_size(NoDeadCode),
SizeDeadCode = byte_size(DeadCode), SizeDeadCode = byte_size(DeadCode),
?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + 40 < SizeNoDeadCode}), Delta = if Backend == aevm -> 40;
Backend == fate -> 20 end,
?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + Delta < SizeNoDeadCode}),
ok ok
end} ]. end} || Backend <- [aevm, fate] ].
check_errors(Expect, ErrorString) -> check_errors(Expect, ErrorString) ->
%% This removes the final single \n as well. %% This removes the final single \n as well.
@ -74,8 +76,7 @@ check_errors(Expect, ErrorString) ->
compile(Backend, Name) -> compile(Backend, Name) ->
compile(Backend, Name, compile(Backend, Name,
[{include, {file_system, [aeso_test_utils:contract_path()]}}] [{include, {file_system, [aeso_test_utils:contract_path()]}}]).
++ [no_implicit_stdlib || not wants_stdlib(Name)]).
compile(Backend, Name, Options) -> compile(Backend, Name, Options) ->
String = aeso_test_utils:read_contract(Name), String = aeso_test_utils:read_contract(Name),
@ -373,12 +374,3 @@ failing_contracts() ->
]} ]}
]. ].
wants_stdlib(Name) ->
lists:member
(Name,
[ "stdlib_include",
"list_comp",
"list_comp_not_a_list",
"list_comp_if_not_bool",
"list_comp_bad_shadow"
]).

14
test/aeso_parser_tests.erl
View File

@ -15,7 +15,7 @@ simple_contracts_test_() ->
?assertMatch( ?assertMatch(
[{contract, _, {con, _, "Identity"}, [{contract, _, {con, _, "Identity"},
[{letfun, _, {id, _, "id"}, [{arg, _, {id, _, "x"}, {id, _, "_"}}], {id, _, "_"}, [{letfun, _, {id, _, "id"}, [{arg, _, {id, _, "x"}, {id, _, "_"}}], {id, _, "_"},
{id, _, "x"}}]}], parse_string(Text, [no_implicit_stdlib])), {id, _, "x"}}]}], parse_string(Text)),
ok ok
end}, end},
{"Operator precedence test.", {"Operator precedence test.",
@ -81,17 +81,21 @@ parse_string(Text, Opts) ->
parse_expr(Text) -> parse_expr(Text) ->
[{letval, _, _, _, Expr}] = [{letval, _, _, _, Expr}] =
parse_string("let _ = " ++ Text, [no_implicit_stdlib]), parse_string("let _ = " ++ Text),
Expr. Expr.
round_trip(Text) -> round_trip(Text) ->
Contract = parse_string(Text, [no_implicit_stdlib]), Contract = parse_string(Text),
Text1 = prettypr:format(aeso_pretty:decls(Contract)), Text1 = prettypr:format(aeso_pretty:decls(strip_stdlib(Contract))),
Contract1 = parse_string(Text1, [no_implicit_stdlib]), Contract1 = parse_string(Text1),
NoSrcLoc = remove_line_numbers(Contract), NoSrcLoc = remove_line_numbers(Contract),
NoSrcLoc1 = remove_line_numbers(Contract1), NoSrcLoc1 = remove_line_numbers(Contract1),
?assertMatch(NoSrcLoc, diff(NoSrcLoc, NoSrcLoc1)). ?assertMatch(NoSrcLoc, diff(NoSrcLoc, NoSrcLoc1)).
strip_stdlib([{namespace, _, {con, _, "ListInternal"}, _} | Decls]) ->
strip_stdlib(Decls);
strip_stdlib(Decls) -> Decls.
remove_line_numbers({line, _L}) -> {line, 0}; remove_line_numbers({line, _L}) -> {line, 0};
remove_line_numbers({col, _C}) -> {col, 0}; remove_line_numbers({col, _C}) -> {col, 0};
remove_line_numbers([H|T]) -> remove_line_numbers([H|T]) ->

9
test/contracts/aens.aes
View File

@ -22,14 +22,16 @@ contract AENSTest =
stateful entrypoint claim(addr : address, stateful entrypoint claim(addr : address,
name : string, name : string,
salt : int) : unit = salt : int,
AENS.claim(addr, name, salt) name_fee : int) : unit =
AENS.claim(addr, name, salt, name_fee)
stateful entrypoint signedClaim(addr : address, stateful entrypoint signedClaim(addr : address,
name : string, name : string,
salt : int, salt : int,
name_fee : int,
sign : signature) : unit = sign : signature) : unit =
AENS.claim(addr, name, salt, signature = sign) AENS.claim(addr, name, salt, name_fee, signature = sign)
// TODO: update() -- how to handle pointers? // TODO: update() -- how to handle pointers?
@ -52,4 +54,3 @@ contract AENSTest =
name : string, name : string,
sign : signature) : unit = sign : signature) : unit =
AENS.revoke(owner, name, signature = sign) AENS.revoke(owner, name, signature = sign)

2
test/contracts/complex_types.aes
View File

@ -50,7 +50,7 @@ contract ComplexTypes =
entrypoint remote_pair(n : int, s : string) : int * string = entrypoint remote_pair(n : int, s : string) : int * string =
state.worker.pair(gas = 10000, n, s) state.worker.pair(gas = 10000, n, s)
entrypoint map(f, xs) = function map(f, xs) =
switch(xs) switch(xs)
[] => [] [] => []
x :: xs => f(x) :: map(f, xs) x :: xs => f(x) :: map(f, xs)

2
test/contracts/list_comp.aes
View File

@ -14,7 +14,7 @@ contract ListComp =
entrypoint l3_true() = [[":)", ":("], [":)", ":("]] entrypoint l3_true() = [[":)", ":("], [":)", ":("]]
entrypoint l4() = [(a, b, c) | let is_pit(a, b, c) = a*a + b*b == c*c entrypoint l4() = [(a, b, c) | let is_pit(a, b, c) = a*a + b*b == c*c
, let base = [1,2,3,4,5,6,7,8,9,10] , let base = [1..10]
, a <- base , a <- base
, b <- base, if (b >= a) , b <- base, if (b >= a)
, c <- base, if (c >= b) , c <- base, if (c >= b)

7
test/contracts/local_poly_fail.aes Normal file
View File

@ -0,0 +1,7 @@
contract Fail =
entrypoint tttt() : bool * int =
let f(x : 'a) : 'a = x
(f(true), f(1))

3
test/contracts/manual_stdlib_include.aes
View File

@ -1,5 +1,4 @@
// This contract should be compiled with no_implicit_stdlib option. // This should include Lists.aes implicitly, since Option.aes does.
// It should include Lists.aes implicitly however, because Option.aes depends on it.
include "Option.aes" include "Option.aes"
contract Test = contract Test =

3
test/contracts/stdlib_include.aes
View File

@ -1,3 +1,6 @@
include "List.aes"
include "Func.aes"
contract StdInc = contract StdInc =
entrypoint test() = List.map((x) => Func.id(x), [1,2,3,4]) entrypoint test() = List.map((x) => Func.id(x), [1,2,3,4])

5
test/contracts/test.aes
View File

@ -91,10 +91,11 @@ contract Identity =
// } // }
// let id(x) = x // let id(x) = x
// let main(xs) = map(double,xs) // let main(xs) = map(double,xs)
entrypoint z(f,x) = x function z(f,x) = x
function s(n) = (f,x)=>f(n(f,x)) function s(n) = (f,x)=>f(n(f,x))
function add(m,n) = (f,x)=>m(f,n(f,x)) function add(m,n) = (f,x)=>m(f,n(f,x))
entrypoint main(_) =
entrypoint main() =
let three=s(s(s(z))) let three=s(s(s(z)))
add(three,three) add(three,three)
(((i)=>i+1),0) (((i)=>i+1),0)

2
test/contracts/tuple_match.aes
View File

@ -1,6 +1,6 @@
contract TuplesMatch = contract TuplesMatch =
entrypoint tuplify3() = (t) => switch(t) function tuplify3() = (t) => switch(t)
(x, y, z) => 3 (x, y, z) => 3
entrypoint fst(p : int * string) = entrypoint fst(p : int * string) =