From 5817b40379d66da0770b97b5d94bba38dafcd4cb Mon Sep 17 00:00:00 2001 From: Paul Guyot Date: Fri, 25 Aug 2023 20:12:08 +0200 Subject: [PATCH] Implement lists:reverse/1,2 as a nif Also rewrite several lists module functions to not use this nif, either because it was not necessary (lists:seq/2,3) or because a non-tail recursive loop is more efficient memory-wise. Signed-off-by: Paul Guyot --- libs/estdlib/src/lists.erl | 139 ++++++++++++---------- src/libAtomVM/nifs.c | 34 ++++++ src/libAtomVM/nifs.gperf | 2 + src/libAtomVM/opcodesswitch.h | 7 +- src/libAtomVM/term.h | 9 +- tests/erlang_tests/CMakeLists.txt | 2 + tests/erlang_tests/test_lists_reverse.erl | 75 ++++++++++++ tests/libs/estdlib/test_lists.erl | 15 +-- tests/test.c | 1 + 9 files changed, 203 insertions(+), 81 deletions(-) create mode 100644 tests/erlang_tests/test_lists_reverse.erl diff --git a/libs/estdlib/src/lists.erl b/libs/estdlib/src/lists.erl index 09f8e2697..99d528603 100644 --- a/libs/estdlib/src/lists.erl +++ b/libs/estdlib/src/lists.erl @@ -33,6 +33,7 @@ member/2, delete/2, reverse/1, + reverse/2, foreach/2, keydelete/3, keyfind/3, @@ -111,28 +112,63 @@ delete(E, L) -> %% @private delete(_, [], Accum) -> - reverse(Accum); + ?MODULE:reverse(Accum); delete(E, [E | T], Accum) -> - reverse(Accum) ++ T; + ?MODULE:reverse(Accum) ++ T; delete(E, [H | T], Accum) -> delete(E, T, [H | Accum]). %%----------------------------------------------------------------------------- %% @param L the list to reverse %% @returns the elements of L in reverse order -%% @doc Reverse the elements of L. +%% @equiv lists:reverse(L, []) +%% @doc Erlang/OTP implementation of this function actually handles few simple +%% cases and calls lists:reverse/2 for the more genertic case. Consequently, +%% calling `lists:reverse/1` without a list or with an improper list of two +%% elements will fail with a function clause exception on Erlang/OTP and with a +%% badarg exception with this implementation. %% @end %%----------------------------------------------------------------------------- --spec reverse(list()) -> list(). -reverse(L) -> - %% TODO this should be done in unit time in a BIF - reverse(L, []). +-spec reverse(L :: list()) -> list(). +reverse(_L) -> + erlang:nif_error(undefined). -%% @private -reverse([], Accum) -> - Accum; -reverse([H | T], Accum) -> - reverse(T, [H | Accum]). +%%----------------------------------------------------------------------------- +%% @param L the list to reverse +%% @param T the tail to append to the reversed list +%% @returns the elements of L in reverse order followed by T +%% @doc Reverse the elements of L, folled by T. +%% If T is not a list or not a proper list, it is appended anyway and the result +%% will be an improper list. +%% +%% If L is not a proper list, the function fails with badarg. +%% +%% Following Erlang/OTP tradition, `lists:reverse/1,2` is a nif. It computes +%% the length and then allocates memory for the list at once (2 * n terms). +%% +%% While this is much faster with AtomVM as allocations are expensive with +%% default heap growth strategy, it can consume more memory until the list +%% passed is garbage collected, as opposed to a recursive implementation where +%% the process garbage collect part of the input list during the reversal. +%% +%% Consequently, tail-recursive implementations calling `lists:reverse/2` +%% can be as expensive or more expensive in memory than list comprehensions or +%% non-tail recursive versions depending on the number of terms saved on the +%% stack between calls. +%% +%% For example, a non-tail recursive join/2 implementation requires two terms +%% on stack for each iteration, so when it returns it will use +%% `n * 3' (stack) + `n * 4' (result list) +%% a tail recursive version will use, on last iteration: +%% `n * 4' (reversed list) + n * 4' (result list) +%% @end +%%----------------------------------------------------------------------------- +-spec reverse + (L :: nonempty_list(E), T :: list(E)) -> nonempty_list(E); + (L :: nonempty_list(), T :: any()) -> maybe_improper_list(); + (L :: [], T) -> T when T :: any(). +reverse(_L, _T) -> + erlang:nif_error(undefined). %%----------------------------------------------------------------------------- %% @param Fun the predicate to evaluate @@ -162,13 +198,13 @@ keydelete(K, I, L) -> %% @private keydelete(_K, _I, [], L) -> - reverse(L); + ?MODULE:reverse(L); keydelete(K, I, [H | T], L2) when is_tuple(H) -> case I =< tuple_size(H) of true -> case element(I, H) of K -> - reverse(L2) ++ T; + ?MODULE:reverse(L2, T); _ -> keydelete(K, I, T, [H | L2]) end; @@ -256,7 +292,7 @@ keyreplace(K, I, [H | T], L, NewTuple, NewList) when is_tuple(H) andalso is_tupl true -> case element(I, H) of K -> - reverse(NewList) ++ [NewTuple | T]; + ?MODULE:reverse(NewList, [NewTuple | T]); _ -> keyreplace(K, I, T, L, NewTuple, [H | NewList]) end; @@ -298,7 +334,7 @@ foldl(Fun, Acc0, [H | T]) -> List :: list() ) -> Acc1 :: term(). foldr(Fun, Acc0, List) -> - foldl(Fun, Acc0, reverse(List)). + foldl(Fun, Acc0, ?MODULE:reverse(List)). %%----------------------------------------------------------------------------- %% @param Fun the predicate to evaluate @@ -381,19 +417,8 @@ search(Pred, [H | T]) -> %% @end %%----------------------------------------------------------------------------- -spec filter(Pred :: fun((Elem :: term()) -> boolean()), List :: list()) -> list(). -filter(Pred, L) -> - filter(Pred, L, []). - -%% @private -filter(_Pred, [], Accum) -> - reverse(Accum); -filter(Pred, [H | T], Accum) -> - case Pred(H) of - true -> - filter(Pred, T, [H | Accum]); - _ -> - filter(Pred, T, Accum) - end. +filter(Pred, L) when is_function(Pred, 1) -> + [X || X <- L, Pred(X)]. %%----------------------------------------------------------------------------- %% @param Sep the separator @@ -403,16 +428,16 @@ filter(Pred, [H | T], Accum) -> %% @end %%----------------------------------------------------------------------------- -spec join(Sep :: any(), List :: list()) -> list(). -join(Sep, L) -> - join(L, Sep, []). +join(_Sep, []) -> + []; +join(Sep, [H | Tail]) -> + [H | join_1(Sep, Tail)]. %% @private -join([], _Sep, Accum) -> - lists:reverse(Accum); -join([E | R], Sep, []) -> - join(R, Sep, [E]); -join([E | R], Sep, Accum) -> - join(R, Sep, [E, Sep | Accum]). +join_1(Sep, [H | Tail]) -> + [Sep, H | join_1(Sep, Tail)]; +join_1(_Sep, []) -> + []. %%----------------------------------------------------------------------------- %% @param From from integer @@ -424,8 +449,8 @@ join([E | R], Sep, Accum) -> %% @end %%----------------------------------------------------------------------------- -spec seq(From :: integer(), To :: integer()) -> list(). -seq(From, To) -> - seq(From, To, 1). +seq(From, To) when is_integer(From) andalso is_integer(To) andalso From =< To -> + seq_r(From, To, 1, []). %%----------------------------------------------------------------------------- %% @param From from integer @@ -447,16 +472,12 @@ seq(From, To, Incr) when seq(To, To, 0) -> [To]; seq(From, To, Incr) -> - seq(From, To, Incr, []). + Last = From + ((To - From) div Incr) * Incr, + seq_r(From, Last, Incr, []). %% @private -seq(From, To, Incr, Accum) when - (Incr > 0 andalso From > To) orelse - (Incr < 0 andalso To > From) --> - reverse(Accum); -seq(From, To, Incr, Accum) -> - seq(From + Incr, To, Incr, [From | Accum]). +seq_r(From, From, _Incr, Acc) -> [From | Acc]; +seq_r(From, To, Incr, Acc) -> seq_r(From, To - Incr, Incr, [To | Acc]). %%----------------------------------------------------------------------------- %% @param List a list @@ -523,20 +544,16 @@ unique(Sorted) -> unique(Sorted, fun(X, Y) -> X =< Y end). %% @private -unique(Sorted, Fun) -> - unique(Sorted, Fun, []). - -%% @private -unique([], _Fun, []) -> +unique([], _Fun) -> []; -unique([X], _Fun, Acc) -> - lists:reverse([X | Acc]); -unique([X, Y | Tail], Fun, Acc) -> +unique([X], _Fun) -> + [X]; +unique([X, Y | Tail], Fun) -> case Fun(X, Y) andalso Fun(Y, X) of true -> - unique([Y | Tail], Fun, Acc); + unique([Y | Tail], Fun); false -> - unique([Y | Tail], Fun, [X | Acc]) + [X | unique([Y | Tail], Fun)] end. %%----------------------------------------------------------------------------- @@ -563,9 +580,9 @@ duplicate(Count, Elem, Acc) -> duplicate(Count - 1, Elem, [Elem | Acc]). %%----------------------------------------------------------------------------- -spec sublist([Elem], integer()) -> [Elem]. sublist(List, Len) when is_integer(Len) andalso Len >= 0 -> - sublist0(List, Len, []). + sublist0(List, Len). %% @private -sublist0(_List, 0, Acc) -> reverse(Acc); -sublist0([], _, Acc) -> reverse(Acc); -sublist0([H | Tail], Len, Acc) -> sublist0(Tail, Len - 1, [H | Acc]). +sublist0([], _Len) -> []; +sublist0(_, 0) -> []; +sublist0([H | Tail], Len) -> [H | sublist0(Tail, Len - 1)]. diff --git a/src/libAtomVM/nifs.c b/src/libAtomVM/nifs.c index b9b76689c..2e52e1fff 100644 --- a/src/libAtomVM/nifs.c +++ b/src/libAtomVM/nifs.c @@ -166,6 +166,7 @@ static term nif_base64_encode_to_string(Context *ctx, int argc, term argv[]); static term nif_base64_decode_to_string(Context *ctx, int argc, term argv[]); static term nif_code_load_abs(Context *ctx, int argc, term argv[]); static term nif_code_load_binary(Context *ctx, int argc, term argv[]); +static term nif_lists_reverse(Context *ctx, int argc, term argv[]); static term nif_maps_next(Context *ctx, int argc, term argv[]); static term nif_unicode_characters_to_list(Context *ctx, int argc, term argv[]); static term nif_unicode_characters_to_binary(Context *ctx, int argc, term argv[]); @@ -694,6 +695,11 @@ static const struct Nif code_load_binary_nif = .base.type = NIFFunctionType, .nif_ptr = nif_code_load_binary }; +static const struct Nif lists_reverse_nif = +{ + .base.type = NIFFunctionType, + .nif_ptr = nif_lists_reverse +}; static const struct Nif maps_next_nif = { .base.type = NIFFunctionType, @@ -4242,6 +4248,34 @@ static term nif_code_load_binary(Context *ctx, int argc, term argv[]) return result; } +static term nif_lists_reverse(Context *ctx, int argc, term argv[]) +{ + // Compared to erlang version, compute the length of the list and allocate + // at once the space for the reverse. + int proper; + size_t len = term_list_length(argv[0], &proper); + if (UNLIKELY(!proper)) { + RAISE_ERROR(BADARG_ATOM); + } + + if (UNLIKELY(memory_ensure_free_with_roots(ctx, len * CONS_SIZE, 2, argv, MEMORY_CAN_SHRINK) != MEMORY_GC_OK)) { + RAISE_ERROR(OUT_OF_MEMORY_ATOM); + } + + term result = term_nil(); + if (argc == 2) { + result = argv[1]; + } + term list_crsr = argv[0]; + while (!term_is_nil(list_crsr)) { + // term is a proper list as verified above + term *list_ptr = term_get_list_ptr(list_crsr); + result = term_list_prepend(list_ptr[LIST_HEAD_INDEX], result, &ctx->heap); + list_crsr = list_ptr[LIST_TAIL_INDEX]; + } + return result; +} + static term nif_maps_next(Context *ctx, int argc, term argv[]) { UNUSED(argc); diff --git a/src/libAtomVM/nifs.gperf b/src/libAtomVM/nifs.gperf index 894cd598f..249ab1714 100644 --- a/src/libAtomVM/nifs.gperf +++ b/src/libAtomVM/nifs.gperf @@ -141,6 +141,8 @@ base64:encode/1, &base64_encode_nif base64:decode/1, &base64_decode_nif base64:encode_to_string/1, &base64_encode_to_string_nif base64:decode_to_string/1, &base64_decode_to_string_nif +lists:reverse/1, &lists_reverse_nif +lists:reverse/2, &lists_reverse_nif maps:next/1, &maps_next_nif unicode:characters_to_list/1, &unicode_characters_to_list_nif unicode:characters_to_list/2, &unicode_characters_to_list_nif diff --git a/src/libAtomVM/opcodesswitch.h b/src/libAtomVM/opcodesswitch.h index 8e783823f..ec15501d7 100644 --- a/src/libAtomVM/opcodesswitch.h +++ b/src/libAtomVM/opcodesswitch.h @@ -3040,11 +3040,10 @@ HOT_FUNC int scheduler_entry_point(GlobalContext *glb) #ifdef IMPL_EXECUTE_LOOP TRACE("get_list/3 %lx, %c%i, %c%i\n", src_value, T_DEST_REG(head_dreg), T_DEST_REG(tail_dreg)); - term head = term_get_list_head(src_value); - term tail = term_get_list_tail(src_value); + term *list_ptr = term_get_list_ptr(src_value); - WRITE_REGISTER(head_dreg, head); - WRITE_REGISTER(tail_dreg, tail); + WRITE_REGISTER(head_dreg, list_ptr[LIST_HEAD_INDEX]); + WRITE_REGISTER(tail_dreg, list_ptr[LIST_TAIL_INDEX]); #endif #ifdef IMPL_CODE_LOADER diff --git a/src/libAtomVM/term.h b/src/libAtomVM/term.h index f4286ed16..089d58b8e 100644 --- a/src/libAtomVM/term.h +++ b/src/libAtomVM/term.h @@ -88,6 +88,9 @@ extern "C" { #define CONS_SIZE 2 #define REFC_BINARY_CONS_OFFSET 4 +#define LIST_HEAD_INDEX 1 +#define LIST_TAIL_INDEX 0 + #define TERM_BINARY_SIZE_IS_HEAP(size) ((size) < REFC_BINARY_MIN) #if TERM_BYTES == 4 @@ -1288,7 +1291,7 @@ static inline term term_list_from_list_ptr(term *list_elem) static inline term term_get_list_head(term t) { term *list_ptr = term_get_list_ptr(t); - return list_ptr[1]; + return list_ptr[LIST_HEAD_INDEX]; } /** @@ -1300,7 +1303,7 @@ static inline term term_get_list_head(term t) static inline term term_get_list_tail(term t) { term *list_ptr = term_get_list_ptr(t); - return *list_ptr; + return list_ptr[LIST_TAIL_INDEX]; } /** @@ -1312,7 +1315,7 @@ static inline term term_get_list_tail(term t) */ MALLOC_LIKE static inline term *term_list_alloc(Heap *heap) { - return memory_heap_alloc(heap, 2); + return memory_heap_alloc(heap, CONS_SIZE); } /** diff --git a/tests/erlang_tests/CMakeLists.txt b/tests/erlang_tests/CMakeLists.txt index 698f1183b..d8c0a1c4d 100644 --- a/tests/erlang_tests/CMakeLists.txt +++ b/tests/erlang_tests/CMakeLists.txt @@ -132,6 +132,7 @@ compile_erlang(test_list_processes) compile_erlang(test_tl) compile_erlang(test_list_to_atom) compile_erlang(test_list_to_existing_atom) +compile_erlang(test_lists_reverse) compile_erlang(test_binary_to_atom) compile_erlang(test_binary_to_existing_atom) compile_erlang(test_atom_to_list) @@ -577,6 +578,7 @@ add_custom_target(erlang_test_modules DEPENDS test_tl.beam test_list_to_atom.beam test_list_to_existing_atom.beam + test_lists_reverse.beam test_binary_to_atom.beam test_binary_to_existing_atom.beam test_atom_to_list.beam diff --git a/tests/erlang_tests/test_lists_reverse.erl b/tests/erlang_tests/test_lists_reverse.erl new file mode 100644 index 000000000..cf826e306 --- /dev/null +++ b/tests/erlang_tests/test_lists_reverse.erl @@ -0,0 +1,75 @@ +% +% This file is part of AtomVM. +% +% Copyright 2023 Paul Guyot +% +% Licensed under the Apache License, Version 2.0 (the "License"); +% you may not use this file except in compliance with the License. +% You may obtain a copy of the License at +% +% http://www.apache.org/licenses/LICENSE-2.0 +% +% Unless required by applicable law or agreed to in writing, software +% distributed under the License is distributed on an "AS IS" BASIS, +% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +% See the License for the specific language governing permissions and +% limitations under the License. +% +% SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later +% + +-module(test_lists_reverse). + +-export([start/0]). + +start() -> + ok = test_lists_reverse_1(), + ok = test_lists_reverse_2(), + 0. + +test_lists_reverse_1() -> + [] = lists:reverse([]), + [a, b, c] = lists:reverse([c, b, a]), + ok = + try + lists:reverse([a, b | improper]), + fail + catch + error:badarg -> ok + end, + ok = + try + lists:reverse(not_a_list), + fail + catch + % AtomVM + error:badarg -> ok; + % BEAM + error:function_clause -> ok + end, + ok. + +test_lists_reverse_2() -> + [] = lists:reverse([], []), + [a, b, c, d, e, f] = lists:reverse([c, b, a], [d, e, f]), + ok = + try + lists:reverse([a, b | improper], [a]), + fail + catch + % AtomVM + error:badarg -> ok; + % BEAM + T:V -> {T, V} + end, + [b, a, c, d | improper] = lists:reverse([a, b], [c, d | improper]), + ok = + try + lists:reverse(not_a_list, []), + fail + catch + error:badarg -> ok + end, + not_a_list = lists:reverse([], not_a_list), + [c, b, a | not_a_list] = lists:reverse([a, b, c], not_a_list), + ok. diff --git a/tests/libs/estdlib/test_lists.erl b/tests/libs/estdlib/test_lists.erl index 57b22b28f..3138cb417 100644 --- a/tests/libs/estdlib/test_lists.erl +++ b/tests/libs/estdlib/test_lists.erl @@ -27,7 +27,6 @@ test() -> ok = test_nth(), ok = test_member(), - ok = test_reverse(), ok = test_delete(), ok = test_keyfind(), ok = test_keydelete(), @@ -49,18 +48,7 @@ test_nth() -> ?ASSERT_MATCH(lists:nth(1, [a, b, c]), a), ?ASSERT_MATCH(lists:nth(2, [a, b, c]), b), ?ASSERT_MATCH(lists:nth(3, [a, b, c]), c), - % try - % lists:nth(-1, [a,b,c]), - % throw(failure) - % catch - % _:_ -> ok - % end, - ok. - -test_reverse() -> - ?ASSERT_MATCH(lists:reverse([]), []), - ?ASSERT_MATCH(lists:reverse([a]), [a]), - ?ASSERT_MATCH(lists:reverse([a, b]), [b, a]), + ?ASSERT_FAILURE(lists:nth(-1, [a, b, c]), function_clause), ok. test_member() -> @@ -193,6 +181,7 @@ test_seq() -> ?ASSERT_MATCH(lists:seq(-1, 2, 3), [-1, 2]), ?ASSERT_MATCH(lists:seq(5, 1, -1), [5, 4, 3, 2, 1]), ?ASSERT_MATCH(lists:seq(1, 1, 0), [1]), + ?ASSERT_MATCH(lists:seq(1, 1), [1]), ?ASSERT_FAILURE(lists:seq(foo, 1)), ?ASSERT_FAILURE(lists:seq(1, bar)), diff --git a/tests/test.c b/tests/test.c index 10da9c755..09ce30feb 100644 --- a/tests/test.c +++ b/tests/test.c @@ -155,6 +155,7 @@ struct Test tests[] = { TEST_CASE_EXPECTED(test_tl, 5), TEST_CASE_EXPECTED(test_list_to_atom, 9), TEST_CASE_EXPECTED(test_list_to_existing_atom, 9), + TEST_CASE(test_lists_reverse), TEST_CASE_EXPECTED(test_binary_to_atom, 9), TEST_CASE_EXPECTED(test_binary_to_existing_atom, 9), TEST_CASE_EXPECTED(test_atom_to_list, 1),