diff --git a/docs/sophia_stdlib.md b/docs/sophia_stdlib.md index 9c580445..e40e6a40 100644 --- a/docs/sophia_stdlib.md +++ b/docs/sophia_stdlib.md @@ -1056,12 +1056,20 @@ List.unzip(l : list('a * 'b)) : list('a) * list('b) Opposite to the `zip` operation. Takes a list of pairs and returns pair of lists with respective elements on same indices. -#### sort +### merge +``` +List.merge(lesser_cmp : ('a, 'a) => bool, l1 : list('a), l2 : list('a)) : list('a) +``` + +Merges two sorted lists into a single sorted list. O(length(l1) + length(l2)) + + +### sort ``` List.sort(lesser_cmp : ('a, 'a) => bool, l : list('a)) : list('a) ``` -Sorts a list using given comparator. `lesser_cmp(x, y)` should return `true` iff `x < y`. If `lesser_cmp` is not transitive or there exists an element `x` such that `lesser_cmp(x, x)` or there exists a pair of elements `x` and `y` such that `lesser_cmp(x, y) && lesser_cmp(y, x)` then the result is undefined. Currently O(n^2). +Sorts a list using given comparator. `lesser_cmp(x, y)` should return `true` iff `x < y`. If `lesser_cmp` is not transitive or there exists an element `x` such that `lesser_cmp(x, x)` or there exists a pair of elements `x` and `y` such that `lesser_cmp(x, y) && lesser_cmp(y, x)` then the result is undefined. O(length(l) * log_2(length(l))). #### intersperse diff --git a/priv/stdlib/List.aes b/priv/stdlib/List.aes index 5354014b..faf853ca 100644 --- a/priv/stdlib/List.aes +++ b/priv/stdlib/List.aes @@ -235,11 +235,67 @@ namespace List = (h1::t1, h2::t2) - // 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) + /** Merges two sorted lists using `lt` comparator + */ + function + merge : (('a, 'a) => bool, list('a), list('a)) => list('a) + merge(lt, x::xs, y::ys) = + if(lt(x, y)) x::merge(lt, xs, y::ys) + else y::merge(lt, x::xs, ys) + merge(_, [], ys) = ys + merge(_, xs, []) = xs + + + /** Mergesort inspired by + * https://hackage.haskell.org/package/base-4.14.1.0/docs/src/Data.OldList.html#sort + */ + function + sort : (('a, 'a) => bool, list('a)) => list('a) + sort(_, []) = [] + sort(lt, l) = + merge_all(lt, monotonic_subs(lt, l)) + + /** Splits list into compound increasing sublists + */ + private function + monotonic_subs : (('a, 'a) => bool, list('a)) => list(list('a)) + monotonic_subs(lt, x::y::rest) = + if(lt(y, x)) desc(lt, y, [x], rest) + else asc(lt, y, [x], rest) + monotonic_subs(_, l) = [l] + + /** Extracts the longest descending prefix and proceeds with monotonic split + */ + private function + desc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a)) + desc(lt, x, acc, h::t) = + if(lt(x, h)) (x::acc) :: monotonic_subs(lt, h::t) + else desc(lt, h, x::acc, t) + desc(_, x, acc, []) = [x::acc] + + /** Extracts the longest ascending prefix and proceeds with monotonic split + */ + private function + asc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a)) + asc(lt, x, acc, h::t) = + if(lt(h, x)) List.reverse(x::acc) :: monotonic_subs(lt, h::t) + else asc(lt, h, x::acc, t) + asc(_, x, acc, []) = [List.reverse(x::acc)] + + /** Merges list of sorted lists + */ + private function + merge_all : (('a, 'a) => bool, list(list('a))) => list('a) + merge_all(_, [part]) = part + merge_all(lt, parts) = merge_all(lt, merge_pairs(lt, parts)) + + /** Single round of `merge_all` – pairs of lists in a list of list + */ + private function + merge_pairs : (('a, 'a) => bool, list(list('a))) => list(list('a)) + merge_pairs(lt, x::y::rest) = merge(lt, x, y) :: merge_pairs(lt, rest) + merge_pairs(_, l) = l + /** Puts `delim` between every two members of the list */ diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index fa1fee5d..8755cb1f 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -749,7 +749,9 @@ check_scope_name_clash(Env, Kind, Name) -> -spec infer_contract_top(env(), main_contract | contract | namespace, [aeso_syntax:decl()], list(option())) -> {env(), [aeso_syntax:decl()]}. infer_contract_top(Env, Kind, Defs0, Options) -> + create_type_errors(), Defs = desugar(Defs0), + destroy_and_report_type_errors(Env), infer_contract(Env, Kind, Defs, Options). %% infer_contract takes a proplist mapping global names to types, and @@ -1689,6 +1691,15 @@ free_vars(L) when is_list(L) -> [V || Elem <- L, V <- free_vars(Elem)]. +next_count() -> + V = case get(counter) of + undefined -> + 0; + X -> X + end, + put(counter, V + 1), + V. + %% Clean up all the ets tables (in case of an exception) ets_tables() -> @@ -1734,6 +1745,18 @@ ets_tab2list(Name) -> TabId = ets_tabid(Name), ets:tab2list(TabId). +ets_insert_ordered(_, []) -> true; +ets_insert_ordered(Name, [H|T]) -> + ets_insert_ordered(Name, H), + ets_insert_ordered(Name, T); +ets_insert_ordered(Name, Object) -> + Count = next_count(), + TabId = ets_tabid(Name), + ets:insert(TabId, {Count, Object}). + +ets_tab2list_ordered(Name) -> + [E || {_, E} <- ets_tab2list(Name)]. + %% Options create_options(Options) -> @@ -1769,17 +1792,17 @@ destroy_and_report_unsolved_constraints(Env) -> %% -- Named argument constraints -- create_named_argument_constraints() -> - ets_new(named_argument_constraints, [bag]). + ets_new(named_argument_constraints, [ordered_set]). destroy_named_argument_constraints() -> ets_delete(named_argument_constraints). get_named_argument_constraints() -> - ets_tab2list(named_argument_constraints). + ets_tab2list_ordered(named_argument_constraints). -spec add_named_argument_constraint(named_argument_constraint()) -> ok. add_named_argument_constraint(Constraint) -> - ets_insert(named_argument_constraints, Constraint), + ets_insert_ordered(named_argument_constraints, Constraint), ok. solve_named_argument_constraints(Env) -> @@ -1853,14 +1876,14 @@ destroy_and_report_unsolved_named_argument_constraints(Env) -> | {add_bytes, aeso_syntax:ann(), concat | split, utype(), utype(), utype()}. create_bytes_constraints() -> - ets_new(bytes_constraints, [bag]). + ets_new(bytes_constraints, [ordered_set]). get_bytes_constraints() -> - ets_tab2list(bytes_constraints). + ets_tab2list_ordered(bytes_constraints). -spec add_bytes_constraint(byte_constraint()) -> true. add_bytes_constraint(Constraint) -> - ets_insert(bytes_constraints, Constraint). + ets_insert_ordered(bytes_constraints, Constraint). solve_bytes_constraints(Env) -> [ solve_bytes_constraint(Env, C) || C <- get_bytes_constraints() ], @@ -1914,18 +1937,18 @@ check_bytes_constraint(Env, {add_bytes, Ann, Fun, A0, B0, C0}) -> create_field_constraints() -> %% A relation from uvars to constraints - ets_new(field_constraints, [bag]). + ets_new(field_constraints, [ordered_set]). destroy_field_constraints() -> ets_delete(field_constraints). -spec constrain([field_constraint()]) -> true. constrain(FieldConstraints) -> - ets_insert(field_constraints, FieldConstraints). + ets_insert_ordered(field_constraints, FieldConstraints). -spec get_field_constraints() -> [field_constraint()]. get_field_constraints() -> - ets_tab2list(field_constraints). + ets_tab2list_ordered(field_constraints). solve_field_constraints(Env) -> FieldCs = @@ -2772,6 +2795,9 @@ mk_error({mixed_record_and_map, Expr}) -> mk_error({named_argument_must_be_literal_bool, Name, Arg}) -> Msg = io_lib:format("Invalid '~s' argument\n~s\nIt must be either 'true' or 'false'.", [Name, pp_expr(" ", instantiate(Arg))]), mk_t_err(pos(Arg), Msg); +mk_error({conflicting_updates_for_field, Upd, Key}) -> + Msg = io_lib:format("Conflicting updates for field '~s'\n", [Key]), + mk_t_err(pos(Upd), Msg); mk_error(Err) -> Msg = io_lib:format("Unknown error: ~p\n", [Err]), mk_t_err(pos(0, 0), Msg). @@ -3003,7 +3029,7 @@ desugar_updates([Upd | Updates]) -> {More, Updates1} = updates_key(Key, Updates), %% Check conflicts case length([ [] || [] <- [Rest | More] ]) of - N when N > 1 -> error({conflicting_updates_for_field, Upd, Key}); + N when N > 1 -> type_error({conflicting_updates_for_field, Upd, Key}); _ -> ok end, [MakeField(lists:append([Rest | More])) | desugar_updates(Updates1)]. diff --git a/src/aeso_parse_lib.erl b/src/aeso_parse_lib.erl index 04b0a769..31065f67 100644 --- a/src/aeso_parse_lib.erl +++ b/src/aeso_parse_lib.erl @@ -74,25 +74,31 @@ %% first argument. I.e. no backtracking to the second argument if the first %% fails. +trampoline({bounce, Cont}) when is_function(Cont, 0) -> + trampoline(Cont()); +trampoline(Res) -> + Res. +-define(BOUNCE(X), {bounce, fun() -> X end}). + %% Apply a parser to its continuation. This compiles a parser to its low-level representation. -spec apply_p(parser(A), fun((A) -> parser1(B))) -> parser1(B). apply_p(?lazy(F), K) -> apply_p(F(), K); apply_p(?fail(Err), _) -> {fail, Err}; -apply_p(?choice([P | Ps]), K) -> lists:foldl(fun(Q, R) -> choice1(apply_p(Q, K), R) end, - apply_p(P, K), Ps); +apply_p(?choice([P | Ps]), K) -> lists:foldl(fun(Q, R) -> choice1(trampoline(apply_p(Q, K)), R) end, + trampoline(apply_p(P, K)), Ps); apply_p(?bind(P, F), K) -> apply_p(P, fun(X) -> apply_p(F(X), K) end); apply_p(?right(P, Q), K) -> apply_p(P, fun(_) -> apply_p(Q, K) end); apply_p(?left(P, Q), K) -> apply_p(P, fun(X) -> apply_p(Q, fun(_) -> K(X) end) end); apply_p(?map(F, P), K) -> apply_p(P, fun(X) -> K(F(X)) end); apply_p(?layout, K) -> {layout, K, {fail, {expected, layout_block}}}; apply_p(?tok(Atom), K) -> {tok_bind, #{Atom => K}}; -apply_p(?return(X), K) -> K(X); +apply_p(?return(X), K) -> ?BOUNCE(K(X)); apply_p([P | Q], K) -> apply_p(P, fun(H) -> apply_p(Q, fun(T) -> K([H | T]) end) end); apply_p(T, K) when is_tuple(T) -> apply_p(tuple_to_list(T), fun(Xs) -> K(list_to_tuple(Xs)) end); apply_p(M, K) when is_map(M) -> {Keys, Ps} = lists:unzip(maps:to_list(M)), apply_p(Ps, fun(Vals) -> K(maps:from_list(lists:zip(Keys, Vals))) end); -apply_p(X, K) -> K(X). +apply_p(X, K) -> ?BOUNCE(K(X)). %% -- Primitive combinators -------------------------------------------------- @@ -160,7 +166,7 @@ layout() -> ?layout. %% @doc Parse a sequence of tokens using a parser. Fails if the parse is ambiguous. -spec parse(parser(A), tokens()) -> {ok, A} | {error, term()}. parse(P, S) -> - case parse1(apply_p(P, fun(X) -> {return_plus, X, {fail, no_error}} end), S) of + case parse1(trampoline(apply_p(P, fun(X) -> {return_plus, X, {fail, no_error}} end)), S) of {[], {Pos, Err}} -> {error, {add_current_file(Pos), parse_error, flatten_error(Err)}}; {[A], _} -> {ok, A}; {As, _} -> {error, {{1, 1}, ambiguous_parse, As}} @@ -241,7 +247,7 @@ col(T) when is_tuple(T) -> element(2, pos(T)). %% If both parsers want the next token we grab it and merge the continuations. choice1({tok_bind, Map1}, {tok_bind, Map2}) -> - {tok_bind, merge_with(fun(F, G) -> fun(T) -> choice1(F(T), G(T)) end end, Map1, Map2)}; + {tok_bind, merge_with(fun(F, G) -> fun(T) -> choice1(trampoline(F(T)), trampoline(G(T))) end end, Map1, Map2)}; %% If both parsers fail we combine the error messages. If only one fails we discard it. choice1({fail, E1}, {fail, E2}) -> {fail, add_error(E1, E2)}; @@ -255,7 +261,7 @@ choice1(P, {return_plus, X, Q}) -> {return_plus, X, choice1(P, Q)}; %% If both sides want a layout block we combine them. If only one side wants a layout block we %% will commit to a layout block is there is one. choice1({layout, F, P}, {layout, G, Q}) -> - {layout, fun(N) -> choice1(F(N), G(N)) end, choice1(P, Q)}; + {layout, fun(N) -> choice1(trampoline(F(N)), trampoline(G(N))) end, choice1(P, Q)}; choice1({layout, F, P}, Q) -> {layout, F, choice1(P, Q)}; choice1(P, {layout, G, Q}) -> {layout, G, choice1(P, Q)}. @@ -278,6 +284,8 @@ parse1(P, S) -> %% The main work horse. Returns a list of possible parses and an error message in case parsing %% fails. -spec parse1(parser1(A), #ts{}, [A], term()) -> {[A], error()}. +parse1({bounce, F}, Ts, Acc, Err) -> + parse1(F(), Ts, Acc, Err); parse1({tok_bind, Map}, Ts, Acc, Err) -> case next_token(Ts) of {T, Ts1} -> diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 425cdd1e..36e70b4a 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -730,6 +730,9 @@ failing_contracts() -> " g : (int, string) => 'c\nto arguments\n" " \"Litwo, ojczyzno moja\" : string">> ]) + , ?TYPE_ERROR(bad_state, + [<>]) ]. -define(Path(File), "code_errors/" ??File). diff --git a/test/contracts/bad_state.aes b/test/contracts/bad_state.aes new file mode 100644 index 00000000..e632a41f --- /dev/null +++ b/test/contracts/bad_state.aes @@ -0,0 +1,5 @@ +contract C = + record state = { foo : int } + entrypoint init(i : int) = + state{ foo = i, + foo = 42 }