From 7fd029e9541e8b40bd4cfc7d5ab3cff438cc8c58 Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Sat, 6 Jul 2024 11:13:04 +0200 Subject: [PATCH 01/11] ESP32: USB serial output Allow serial output on certain boards with no usable UART. It must be manually enabled (by editing ESP32 main), tiny_usb must be installed: `idf.py add-dependency esp_tinyusb` and CDC enabled with menu config. Fixes #1190 Signed-off-by: Davide Bettio --- CHANGELOG.md | 1 + src/platforms/esp32/main/main.c | 43 +++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 528fbaa96..8e0d0ab1e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Support for `erlang:apply/2` - Support for `lists:keystore/4` - Support for `erlang:size/1` bif +- Support for USB serial output on ESP32 (needs to be manually enabled) ### Changed diff --git a/src/platforms/esp32/main/main.c b/src/platforms/esp32/main/main.c index 4f651b8b2..45f916e97 100644 --- a/src/platforms/esp32/main/main.c +++ b/src/platforms/esp32/main/main.c @@ -37,6 +37,15 @@ #include #include +// before enabling this: +// idf.py add-dependency esp_tinyusb +// and enable CDC in menu config +#ifdef USE_USB_SERIAL +#include "tinyusb.h" +#include "tusb_cdc_acm.h" +#include "tusb_console.h" +#endif + #include "esp32_sys.h" #define TAG "AtomVM" @@ -60,6 +69,10 @@ void app_main() { esp32_sys_queue_init(); +#ifdef USE_USB_SERIAL + init_usb_serial(); +#endif + fprintf(stdout, "%s", ATOMVM_BANNER); ESP_LOGI(TAG, "Starting AtomVM revision " ATOMVM_VERSION); @@ -136,3 +149,33 @@ void app_main() } } } + +#ifdef USE_USB_SERIAL +void init_usb_serial() +{ + /* Setting TinyUSB up */ + ESP_LOGI(TAG, "USB initialization"); + + const tinyusb_config_t tusb_cfg = { + .device_descriptor = NULL, + .string_descriptor = NULL, + .external_phy = false, // In the most cases you need to use a `false` value +#if (TUD_OPT_HIGH_SPEED) + .fs_configuration_descriptor = NULL, + .hs_configuration_descriptor = NULL, + .qualifier_descriptor = NULL, +#else + .configuration_descriptor = NULL, +#endif // TUD_OPT_HIGH_SPEED + }; + + ESP_ERROR_CHECK(tinyusb_driver_install(&tusb_cfg)); + + tinyusb_config_cdcacm_t acm_cfg = { 0 }; // the configuration uses default values + ESP_ERROR_CHECK(tusb_cdc_acm_init(&acm_cfg)); + + esp_tusb_init_console(TINYUSB_CDC_ACM_0); // log to usb + + ESP_LOGI(TAG, "USB initialization: done."); +} +#endif From 388e846ab85d26409ebe48948e36f57b15d5b858 Mon Sep 17 00:00:00 2001 From: Peter M Date: Wed, 10 Jul 2024 13:00:55 +0200 Subject: [PATCH 02/11] Bump CI esp-idf 5.3 beta2 -> rc1 Bump esp-idf 5.3 CI to rc1. Signed-off-by: Peter M --- .github/workflows/esp32-build.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/esp32-build.yaml b/.github/workflows/esp32-build.yaml index 6f41f5c81..0f8650976 100644 --- a/.github/workflows/esp32-build.yaml +++ b/.github/workflows/esp32-build.yaml @@ -40,7 +40,7 @@ jobs: - 'v5.0.6' - 'v5.1.4' - 'v5.2.2' - - 'v5.3-beta2' + - 'v5.3-rc1' exclude: - esp-idf-target: "esp32c3" From efddb85e73166f47b0c39e8ebf030a95375b9d55 Mon Sep 17 00:00:00 2001 From: Peter M Date: Thu, 11 Jul 2024 21:54:14 +0200 Subject: [PATCH 03/11] Add .git_ignore esp32/test/__pycache__/** When running pytest in esp32/test it will create files eg: "src/platforms/esp32/test/__pycache__/test_atomvm.cpython-312-pytest-8.2.2.pyc" this git_ignores that folder. Signed-off-by: Peter M --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index d5f23a508..9501ec5b7 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ xcode/** src/platforms/esp32/build/** src/platforms/esp32/build/**/*.d src/platforms/esp32/test/build/** +src/platforms/esp32/test/__pycache__/** src/platforms/esp32/components/** src/platforms/esp32/managed_components/** src/platforms/esp32/sdkconfig From bd66d66f9d4f4c92c1d9afec2fe70a7ab4e8f802 Mon Sep 17 00:00:00 2001 From: Peter M Date: Tue, 16 Jul 2024 15:45:54 +0200 Subject: [PATCH 04/11] Fix pico builds (cmake 3.30) cmake 3.30 changed their private api. Signed-off-by: Peter M --- src/platforms/rp2040/CMakeLists.txt | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/platforms/rp2040/CMakeLists.txt b/src/platforms/rp2040/CMakeLists.txt index 8641f013a..7a275ed03 100644 --- a/src/platforms/rp2040/CMakeLists.txt +++ b/src/platforms/rp2040/CMakeLists.txt @@ -33,8 +33,14 @@ list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/../../../CMakeModules pico_sdk_init() # Pico SDK forces compiler, but we really want to know its features. -include(${CMAKE_ROOT}/Modules/CMakeDetermineCompileFeatures.cmake) -CMAKE_DETERMINE_COMPILE_FEATURES(C) +# TODO: avoid using private api: https://discourse.cmake.org/t/cmakedeterminecompilerfeatures-cmake-is-no-more-in-3-30-bug-or-not/11176/3 +if(CMAKE_VERSION VERSION_GREATER_EQUAL 3.30.0) + include(${CMAKE_ROOT}/Modules/CMakeDetermineCompilerSupport.cmake) + cmake_determine_compiler_support(C) +else() + include(${CMAKE_ROOT}/Modules/CMakeDetermineCompileFeatures.cmake) + CMAKE_DETERMINE_COMPILE_FEATURES(C) +endif() enable_language( C CXX ASM ) From f28687ca13d459493cb8eb874121f01be7a60e1b Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Sat, 13 Jul 2024 19:11:19 +0200 Subject: [PATCH 05/11] Add lists:filtermap/2 Add filtermap function taken from: otp/blob/master/lib/stdlib/src/lists.erl Signed-off-by: Davide Bettio --- CHANGELOG.md | 1 + libs/estdlib/src/lists.erl | 42 +++++++++++++++++++++++++++++++ tests/libs/estdlib/test_lists.erl | 16 ++++++++++++ 3 files changed, 59 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8e0d0ab1e..f71063ed8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Support for `lists:keystore/4` - Support for `erlang:size/1` bif - Support for USB serial output on ESP32 (needs to be manually enabled) +- Support for `lists:filtermap/2` ### Changed diff --git a/libs/estdlib/src/lists.erl b/libs/estdlib/src/lists.erl index f8c84e341..fb9e8ad80 100644 --- a/libs/estdlib/src/lists.erl +++ b/libs/estdlib/src/lists.erl @@ -50,6 +50,7 @@ flatten/1, search/2, filter/2, + filtermap/2, join/2, seq/2, seq/3, sort/1, sort/2, @@ -469,6 +470,47 @@ search(Pred, [H | T]) -> filter(Pred, L) when is_function(Pred, 1) -> [X || X <- L, Pred(X)]. +% Taken from `otp/blob/master/lib/stdlib/src/lists.erl` + +%%----------------------------------------------------------------------------- +%% @param Fun the filter/map fun +%% @param List1 the list where given fun will be applied +%% @returns Returns the result of application of given fun over given list items +%% @doc Calls `Fun(Elem)' on successive elements `Elem' of `List1' in order to update or +%% remove elements from `List1'. +%% +%% `Fun/1' must return either a Boolean or a tuple `{true, Value}'. The function +%% returns the list of elements for which `Fun' returns a new value, where a value +%% of `true' is synonymous with `{true, Elem}'. +%% +%% Example: +%% `1> lists:filtermap(fun(X) -> case X rem 2 of 0 -> {true, X div 2}; _ -> false end end, [1,2,3,4,5]).' +%% `[1,2]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec filtermap(Fun, List1) -> List2 when + Fun :: fun((Elem) -> boolean() | {'true', Value}), + List1 :: [Elem], + List2 :: [Elem | Value], + Elem :: term(), + Value :: term(). + +filtermap(F, List) when is_function(F, 1) -> + filtermap_1(F, List). + +filtermap_1(F, [Hd | Tail]) -> + case F(Hd) of + true -> + [Hd | filtermap_1(F, Tail)]; + {true, Val} -> + [Val | filtermap_1(F, Tail)]; + false -> + filtermap_1(F, Tail) + end; +filtermap_1(_F, []) -> + []. + %%----------------------------------------------------------------------------- %% @param Sep the separator %% @param List list diff --git a/tests/libs/estdlib/test_lists.erl b/tests/libs/estdlib/test_lists.erl index 07fc76cf5..bb7350e65 100644 --- a/tests/libs/estdlib/test_lists.erl +++ b/tests/libs/estdlib/test_lists.erl @@ -45,6 +45,7 @@ test() -> ok = test_sort(), ok = test_split(), ok = test_usort(), + ok = test_filtermap(), ok. test_nth() -> @@ -280,4 +281,19 @@ test_usort() -> ok. +test_filtermap() -> + ?ASSERT_MATCH( + lists:filtermap( + fun(X) -> + case X rem 2 of + 0 -> {true, X div 2}; + _ -> false + end + end, + [1, 2, 3, 4, 5] + ), + [1, 2] + ), + ok. + id(X) -> X. From c8ae1d156e264ec51a2ea4843aa45bb1c7949170 Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Wed, 17 Jul 2024 14:54:03 +0200 Subject: [PATCH 06/11] Add queue module Add queue module based on OTP-27 one. Taken from: https://raw.githubusercontent.com/erlang/otp/OTP-27.0.1/lib/stdlib/src/queue.erl Compared to the original version, Okasaki API has been removed, as it seems not very popular. Also documentation style has been reworker to match currently used style. Last, but not least, source has been reformatted. Signed-off-by: Davide Bettio --- CHANGELOG.md | 1 + libs/estdlib/src/CMakeLists.txt | 1 + libs/estdlib/src/queue.erl | 1139 +++++++++++++++++++++++++++++ tests/libs/estdlib/CMakeLists.txt | 1 + tests/libs/estdlib/test_queue.erl | 341 +++++++++ tests/libs/estdlib/tests.erl | 1 + 6 files changed, 1484 insertions(+) create mode 100644 libs/estdlib/src/queue.erl create mode 100644 tests/libs/estdlib/test_queue.erl diff --git a/CHANGELOG.md b/CHANGELOG.md index f71063ed8..d6914460e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Support for `erlang:size/1` bif - Support for USB serial output on ESP32 (needs to be manually enabled) - Support for `lists:filtermap/2` +- Support for standard library `queue` module ### Changed diff --git a/libs/estdlib/src/CMakeLists.txt b/libs/estdlib/src/CMakeLists.txt index 135fb256a..233ff78e9 100644 --- a/libs/estdlib/src/CMakeLists.txt +++ b/libs/estdlib/src/CMakeLists.txt @@ -49,6 +49,7 @@ set(ERLANG_MODULES logger logger_std_h proplists + queue socket ssl string diff --git a/libs/estdlib/src/queue.erl b/libs/estdlib/src/queue.erl new file mode 100644 index 000000000..77f245c72 --- /dev/null +++ b/libs/estdlib/src/queue.erl @@ -0,0 +1,1139 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% + +% +% This is shrinked down version of OTP queue module, without Okasaki API support +% + +-module(queue). + +%% Creation, inspection and conversion +-export([new/0, is_queue/1, is_empty/1, len/1, to_list/1, from_list/1, member/2]). +%% Original style API +-export([in/2, in_r/2, out/1, out_r/1]). +%% Less garbage style API +-export([get/1, get_r/1, peek/1, peek_r/1, drop/1, drop_r/1]). + +%% Higher level API +-export([ + reverse/1, + join/2, + split/2, + filter/2, + filtermap/2, + fold/3, + any/2, + all/2, + delete/2, + delete_r/2, + delete_with/2, + delete_with_r/2 +]). + +-export_type([queue/0, queue/1]). + +%%-------------------------------------------------------------------------- +%% Efficient implementation of double ended fifo queues +%% +%% Queue representation +%% +%% {RearList,FrontList} +%% +%% The first element in the queue is at the head of the FrontList +%% The last element in the queue is at the head of the RearList, +%% that is; the RearList is reversed. +%% + +-opaque queue(Item) :: {list(Item), list(Item)}. + +-type queue() :: queue(_). + +%%-------------------------------------------------------------------------- +%% Creation, inspection and conversion + +% Performance: +% O(1) + +%%----------------------------------------------------------------------------- +%% @returns Returns an empty queue. +%% @doc This function returns an empty queue. +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec new() -> queue(none()). +new() -> {[], []}. + +% Performance: +% O(1) + +%%----------------------------------------------------------------------------- +%% @param Term the term to be tested +%% @returns Returns `true' if `Term' is a queue, otherwise `false' +%% @doc Tests if `Term' is a queue and returns `true' if so, otherwise `false'. +%% Note that the test will return `true' for a term coinciding with the +%% representation of a queue, even when not constructed by this module. +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec is_queue(Term :: term()) -> boolean(). +is_queue({R, F}) when is_list(R), is_list(F) -> + true; +is_queue(_) -> + false. + +% Performance: +% O(1) + +%%----------------------------------------------------------------------------- +%% @param Q the queue to be tested +%% @returns Returns `true' if `Q' is empty, otherwise `false' +%% @doc Tests if `Q' is empty and returns `true' if so, otherwise `false'. +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec is_empty(Q :: queue()) -> boolean(). +is_empty({[], []}) -> + true; +is_empty({In, Out}) when is_list(In), is_list(Out) -> + false; +is_empty(Q) -> + erlang:error(badarg, [Q]). + +%% O(len(Q)) +%%----------------------------------------------------------------------------- +%% @param Q the queue whose length is to be calculated +%% @returns Returns the length of queue `Q' +%% @doc Calculates and returns the length of queue `Q'. +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec len(Q :: queue()) -> non_neg_integer(). +len({R, F}) when is_list(R), is_list(F) -> + length(R) + length(F); +len(Q) -> + erlang:error(badarg, [Q]). + +% Performance: +% O(len(Q)) + +%%----------------------------------------------------------------------------- +%% @param Q the queue to be converted to a list +%% @returns Returns a list of the items in the queue +%% @doc Returns a list of the items in the queue in the same order; the front +%% item of the queue becomes the head of the list. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> List == queue:to_list(Queue).' +%% `true' +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec to_list(Q :: queue(Item)) -> list(Item). +to_list({In, Out}) when is_list(In), is_list(Out) -> + Out ++ lists:reverse(In, []); +to_list(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Create queue from list +% O(length(L)) + +%%----------------------------------------------------------------------------- +%% @param L the list to be converted to a queue +%% @returns Returns a queue containing the items in `L' in the same order +%% @doc Returns a queue containing the items in `L' in the same order; the head +%% item of the list becomes the front item of the queue. +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec from_list(L :: list(Item)) -> queue(Item). +from_list(L) when is_list(L) -> + f2r(L); +from_list(L) -> + erlang:error(badarg, [L]). + +% How works: +% Return true or false depending on if element is in queue +% O(length(Q)) worst case + +%%----------------------------------------------------------------------------- +%% @param Item the item to be searched in the queue +%% @param Q the queue to be searched +%% @returns Returns `true' if `Item' matches some element in `Q', otherwise `false' +%% @doc Returns `true' if `Item' matches some element in `Q', otherwise `false'. +%% This function is part of the Original API. +%% @end +%%----------------------------------------------------------------------------- +-spec member(Item, Q :: queue(Item)) -> boolean(). +member(X, {R, F}) when is_list(R), is_list(F) -> + lists:member(X, R) orelse lists:member(X, F); +member(X, Q) -> + erlang:error(badarg, [X, Q]). + +%%-------------------------------------------------------------------------- +%% Original style API + +% How works: +% Append to tail/rear +% Put at least one element in each list, if it is cheap +% O(1) + +%%----------------------------------------------------------------------------- +%% @param Item the item that will be enqueued (inserted at the rear of the queue) +%% @param Q1 the queue where the item will be inserted in +%% @returns Returns the queue with `Item' inserted at the rear of the queue +%% @doc Inserts `Item' at the rear of queue `Q1'. Returns the resulting queue `Q2'. +%% This function is part of the Original API +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue1 = queue:in(100, Queue).' +%% `{[100,5,4,3],[1,2]}' +%% `3> queue:to_list(Queue1).' +%% `[1,2,3,4,5,100]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec in(Item, Q1 :: queue(Item)) -> Q2 :: queue(Item). +in(X, {[_] = In, []}) -> + {[X], In}; +in(X, {In, Out}) when is_list(In), is_list(Out) -> + {[X | In], Out}; +in(X, Q) -> + erlang:error(badarg, [X, Q]). + +% How works: +% Prepend to head/front +% Put at least one element in each list, if it is cheap +% O(1) + +%%----------------------------------------------------------------------------- +%% @param Item the item that will be enqueued (inserted at the front of the queue) +%% @param Q1 the queue where the item will be inserted in +%% @returns Returns the queue with `Item' inserted at the front of the queue +%% @doc Inserts `Item' at the front of queue `Q1'. Returns the resulting queue `Q2'. +%% This function is part of the Original API +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue1 = queue:in_r(100, Queue).' +%% `{[5,4,3],[100,1,2]}' +%% `3> queue:to_list(Queue1).' +%% `[100,1,2,3,4,5]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec in_r(Item, Q1 :: queue(Item)) -> Q2 :: queue(Item). +in_r(X, {[], [_] = F}) -> + {F, [X]}; +in_r(X, {R, F}) when is_list(R), is_list(F) -> + {R, [X | F]}; +in_r(X, Q) -> + erlang:error(badarg, [X, Q]). + +% How works: +% Take from head/front +% O(1) amortized, O(len(Q)) worst case + +%%----------------------------------------------------------------------------- +%% @param Q1 the queue from which the item will be dequeued (removed from the front) +%% @returns Returns a tuple `{{value, Item}, Q2}' where `Item' is the item removed +%% and `Q2' is the resulting queue. If `Q1' is empty, tuple `{empty, Q1}' is returned +%% @doc Removes the item at the front of queue `Q1'. Returns tuple +%% `{{value, Item}, Q2}', where `Item' is the item removed and `Q2' is the +%% resulting queue. If `Q1' is empty, tuple `{empty, Q1}' is returned. +%% This function is part of the Original API +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> {{value, 1=Item}, Queue1} = queue:out(Queue).' +%% `{{value,1},{[5,4,3],[2]}}' +%% `3> queue:to_list(Queue1).' +%% `[2,3,4,5]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec out(Q1 :: queue(Item)) -> + {{value, Item}, Q2 :: queue(Item)} + | {empty, Q1 :: queue(Item)}. +out({[], []} = Q) -> + {empty, Q}; +out({[V], []}) -> + {{value, V}, {[], []}}; +out({[Y | In], []}) -> + [V | Out] = lists:reverse(In, []), + {{value, V}, {[Y], Out}}; +out({In, [V]}) when is_list(In) -> + {{value, V}, r2f(In)}; +out({In, [V | Out]}) when is_list(In) -> + {{value, V}, {In, Out}}; +out(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Take from tail/rear +% O(1) amortized, O(len(Q)) worst case + +%%----------------------------------------------------------------------------- +%% @param Q1 the queue from which the item will be dequeued (removed from the rear) +%% @returns Returns a tuple `{{value, Item}, Q2}' where `Item' is the item removed +%% and `Q2' is the resulting queue. If `Q1' is empty, tuple `{empty, Q1}' is returned +%% @doc Removes the item at the rear of queue `Q1'. Returns tuple `{{value, Item}, Q2}', +%% where `Item' is the item removed and `Q2' is the new queue. If `Q1' is empty, +%% tuple `{empty, Q1}' is returned. +%% This function is part of the Original API +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> {{value, 5=Item}, Queue1} = queue:out_r(Queue).' +%% `{{value,5},{[4,3],[1,2]}}' +%% `3> queue:to_list(Queue1).' +%% `[1,2,3,4]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec out_r(Q1 :: queue(Item)) -> + {{value, Item}, Q2 :: queue(Item)} + | {empty, Q1 :: queue(Item)}. +out_r({[], []} = Q) -> + {empty, Q}; +out_r({[], [V]}) -> + {{value, V}, {[], []}}; +out_r({[], [Y | Out]}) -> + [V | In] = lists:reverse(Out, []), + {{value, V}, {In, [Y]}}; +out_r({[V], Out}) when is_list(Out) -> + {{value, V}, f2r(Out)}; +out_r({[V | In], Out}) when is_list(Out) -> + {{value, V}, {In, Out}}; +out_r(Q) -> + erlang:error(badarg, [Q]). + +%%-------------------------------------------------------------------------- +%% Less garbage style API. + +% How works: +% Return the first element in the queue +% O(1) since the queue is supposed to be well formed + +%%----------------------------------------------------------------------------- +%% @param Q the queue from which the first element will be returned +%% @returns Returns `Item' at the front of queue `Q'. Fails with reason `empty' if `Q' is empty +%% @doc Returns `Item' at the front of queue `Q'. +%% Fails with reason `empty' if `Q' is empty. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> 1 == queue:get(Queue).' +%% `true' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec get(Q :: queue(Item)) -> Item. +get({[], []} = Q) -> + erlang:error(empty, [Q]); +get({R, F}) when is_list(R), is_list(F) -> + get(R, F); +get(Q) -> + erlang:error(badarg, [Q]). + +-spec get(list(), list()) -> term(). +get(R, [H | _]) when is_list(R) -> + H; +get([H], []) -> + H; +% malformed queue -> O(len(Q)) +get([_ | R], []) -> + lists:last(R). + +% How works: +% Return the last element in the queue +% O(1) since the queue is supposed to be well formed + +%%----------------------------------------------------------------------------- +%% @param Q the queue from which the last element will be returned +%% @returns Returns `Item' at the rear of queue `Q'. Fails with reason `empty' if `Q' is empty +%% @doc Returns `Item' at the rear of queue `Q'. +%% Fails with reason `empty' if `Q' is empty. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> 5 == queue:get_r(Queue).' +%% `true' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec get_r(Q :: queue(Item)) -> Item. +get_r({[], []} = Q) -> + erlang:error(empty, [Q]); +get_r({[H | _], F}) when is_list(F) -> + H; +get_r({[], [H]}) -> + H; +% malformed queue -> O(len(Q)) +get_r({[], [_ | F]}) -> + lists:last(F); +get_r(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Return the first element in the queue +% O(1) since the queue is supposed to be well formed + +%%----------------------------------------------------------------------------- +%% @param Q the queue from which the first element will be returned +%% @returns Returns tuple `{value, Item}', where `Item' is the front item of `Q', +%% or `empty' if `Q' is empty +%% @doc Returns tuple `{value, Item}', where `Item' is the front item of `Q', +%% or `empty' if `Q' is empty. +%% +%% Example: +%% `1> queue:peek(queue:new()).' +%% `empty' +%% `2> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `3> queue:peek(Queue).' +%% `{value, 1}' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec peek(Q :: queue(Item)) -> empty | {value, Item}. +peek({[], []}) -> + empty; +peek({R, [H | _]}) when is_list(R) -> + {value, H}; +peek({[H], []}) -> + {value, H}; +% malformed queue -> O(len(Q)) +peek({[_ | R], []}) -> + {value, lists:last(R)}; +peek(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Return the last element in the queue +% O(1) since the queue is supposed to be well formed + +%%----------------------------------------------------------------------------- +%% @param Q the queue from which the last element will be returned +%% @returns Returns tuple `{value, Item}', where `Item' is the rear item of `Q', +%% or `empty' if `Q' is empty +%% @doc Returns tuple `{value, Item}', where `Item' is the rear item of `Q', +%% or `empty' if `Q' is empty. +%% +%% Example: +%% `1> queue:peek_r(queue:new()).' +%% `empty' +%% `2> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `3> queue:peek_r(Queue).' +%% `{value, 5}' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec peek_r(Q :: queue(Item)) -> empty | {value, Item}. +peek_r({[], []}) -> + empty; +peek_r({[H | _], F}) when is_list(F) -> + {value, H}; +peek_r({[], [H]}) -> + {value, H}; +% malformed queue -> O(len(Q)) +peek_r({[], [_ | R]}) -> + {value, lists:last(R)}; +peek_r(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Remove the first element and return resulting queue +% O(1) amortized + +%%----------------------------------------------------------------------------- +%% @param Q1 the queue from which the first element will be removed +%% @returns Returns a queue `Q2' that is the result of removing the front item from `Q1'. +%% Fails with reason `empty' if `Q1' is empty +%% @doc Returns a queue `Q2' that is the result of removing the front item from `Q1'. +%% Fails with reason `empty' if `Q1' is empty. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue = queue:drop(Queue).' +%% `{[5,4,3],[2]}' +%% `3> queue:to_list(Queue1).' +%% `[2,3,4,5]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec drop(Q1 :: queue(Item)) -> Q2 :: queue(Item). +drop({[], []} = Q) -> + erlang:error(empty, [Q]); +drop({[_], []}) -> + {[], []}; +drop({[Y | R], []}) -> + [_ | F] = lists:reverse(R, []), + {[Y], F}; +drop({R, [_]}) when is_list(R) -> + r2f(R); +drop({R, [_ | F]}) when is_list(R) -> + {R, F}; +drop(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Remove the last element and return resulting queue +% O(1) amortized + +%%----------------------------------------------------------------------------- +%% @param Q1 the queue from which the last element will be removed +%% @returns Returns a queue `Q2' that is the result of removing the rear item from `Q1'. +%% Fails with reason `empty' if `Q1' is empty +%% @doc Returns a queue `Q2' that is the result of removing the rear item from `Q1'. +%% Fails with reason `empty' if `Q1' is empty. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue = queue:drop_r(Queue).' +%% `{[4,3],[1,2]}' +%% `3> queue:to_list(Queue1).' +%% `[1,2,3,4]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec drop_r(Q1 :: queue(Item)) -> Q2 :: queue(Item). +drop_r({[], []} = Q) -> + erlang:error(empty, [Q]); +drop_r({[], [_]}) -> + {[], []}; +drop_r({[], [Y | F]}) -> + [_ | R] = lists:reverse(F, []), + {R, [Y]}; +drop_r({[_], F}) when is_list(F) -> + f2r(F); +drop_r({[_ | R], F}) when is_list(F) -> + {R, F}; +drop_r(Q) -> + erlang:error(badarg, [Q]). + +%%-------------------------------------------------------------------------- +%% Higher level API + +% How works: +% Return reversed queue +% O(1) + +%%----------------------------------------------------------------------------- +%% @param Q1 the queue to be reversed +%% @returns Returns a queue `Q2' containing the items of `Q1' in reverse order +%% @doc Returns a queue `Q2' containing the items of `Q1' in reverse order. +%% This function is part of the Original API +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue1 = queue:reverse(Queue).' +%% `{[2,1],[3,4,5]}' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec reverse(Q1 :: queue(Item)) -> Q2 :: queue(Item). +reverse({R, F}) when is_list(R), is_list(F) -> + {F, R}; +reverse(Q) -> + erlang:error(badarg, [Q]). + +% How works: +% Join two queues +% Q2 empty: O(1) +% else: O(len(Q1)) + +%%----------------------------------------------------------------------------- +%% @param Q1 the first queue to be joined +%% @param Q2 the second queue to be joined +%% @returns Returns a queue `Q3' that is the result of joining `Q1' and `Q2' with +%% `Q1' in front of `Q2' +%% @doc Returns a queue `Q3' that is the result of joining `Q1' and `Q2' with +%% `Q1' in front of `Q2'. +%% This function is part of the Original API +%% +%% Example: +%% `1> Queue1 = queue:from_list([1,3]).' +%% `{[3],[1]}' +%% `2> Queue2 = queue:from_list([2,4]).' +%% `{[4],[2]}' +%% `3> queue:to_list(queue:join(Queue1, Queue2)).' +%% `[1,3,2,4]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec join(Q1 :: queue(Item), Q2 :: queue(Item)) -> Q3 :: queue(Item). +join({R, F} = Q, {[], []}) when is_list(R), is_list(F) -> + Q; +join({[], []}, {R, F} = Q) when is_list(R), is_list(F) -> + Q; +join({R1, F1}, {R2, F2}) when is_list(R1), is_list(F1), is_list(R2), is_list(F2) -> + {R2, F1 ++ lists:reverse(R1, F2)}; +join(Q1, Q2) -> + erlang:error(badarg, [Q1, Q2]). + +% How works: +% Split a queue in two +% N = 0..len(Q) +% O(max(N, len(Q))) + +%%----------------------------------------------------------------------------- +%% @param N the number of items to be put in the first resulting queue `Q2' +%% @param Q1 the queue to be split +%% @returns Returns a tuple `{Q2, Q3}' where `Q2' contains the first `N' items +%% of `Q1' and `Q3' contains the remaining items +%% @doc Splits `Q1' in two. The `N' front items are put in `Q2' and the rest +%% in `Q3'. +%% This function is part of the Original API +%% @end +%%----------------------------------------------------------------------------- +-spec split(N :: non_neg_integer(), Q1 :: queue(Item)) -> + {Q2 :: queue(Item), Q3 :: queue(Item)}. +split(0, {R, F} = Q) when is_list(R), is_list(F) -> + {{[], []}, Q}; +split(N, {R, F} = Q) when is_integer(N), N >= 1, is_list(R), is_list(F) -> + Lf = erlang:length(F), + % Lf >= 2 + if + N < Lf -> + [X | F1] = F, + split_f1_to_r2(N - 1, R, F1, [], [X]); + N > Lf -> + Lr = length(R), + M = Lr - (N - Lf), + if + M < 0 -> + erlang:error(badarg, [N, Q]); + M > 0 -> + [X | R1] = R, + split_r1_to_f2(M - 1, R1, F, [X], []); + % M == 0 + true -> + {Q, {[], []}} + end; + % N == Lf + true -> + {f2r(F), r2f(R)} + end; +split(N, Q) -> + erlang:error(badarg, [N, Q]). + +%% Move N elements from F1 to R2 +split_f1_to_r2(0, R1, F1, R2, F2) -> + {{R2, F2}, {R1, F1}}; +split_f1_to_r2(N, R1, [X | F1], R2, F2) -> + split_f1_to_r2(N - 1, R1, F1, [X | R2], F2). + +%% Move N elements from R1 to F2 +split_r1_to_f2(0, R1, F1, R2, F2) -> + {{R1, F1}, {R2, F2}}; +split_r1_to_f2(N, [X | R1], F1, R2, F2) -> + split_r1_to_f2(N - 1, R1, F1, R2, [X | F2]). + +% How it works: +% filter, or rather filtermap with insert, traverses in queue order +% +% Fun(_) -> List: O(length(List) * len(Q)) +% else: O(len(Q) + +%%----------------------------------------------------------------------------- +%% @param Fun the function to be applied to each item in the queue +%% @param Q1 the queue where the function will be applied +%% @returns Returns a queue `Q2' that is the result of calling `Fun(Item)' on all items in `Q1' +%% @doc Returns a queue `Q2' that is the result of calling `Fun(Item)' on all items in `Q1'. +%% If `Fun(Item)' returns `true', `Item' is copied to the result queue. If it returns +%% `false', `Item' is not copied. If it returns a list, the list elements are inserted +%% instead of `Item' in the result queue. +%% +%% Example 1: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue1 = queue:filter(fun (E) -> E > 2 end, Queue).' +%% `{[5],[3,4]}' +%% `3> queue:to_list(Queue1).' +%% `[3,4,5]' +%% +%% Example 2: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue1 = queue:filter(fun (E) -> [E, E+1] end, Queue).' +%% `{[6,5,5,4,4,3],[1,2,2,3]}' +%% `3> queue:to_list(Queue1).' +%% `[1,2,2,3,3,4,4,5,5,6]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec filter(Fun, Q1 :: queue(Item)) -> Q2 :: queue(Item) when + Fun :: fun((Item) -> boolean() | list(Item)). +filter(Fun, {R0, F0}) when is_function(Fun, 1), is_list(R0), is_list(F0) -> + F = filter_f(Fun, F0), + R = filter_r(Fun, R0), + if + R =:= [] -> + f2r(F); + F =:= [] -> + r2f(R); + true -> + {R, F} + end; +filter(Fun, Q) -> + erlang:error(badarg, [Fun, Q]). + +%% Call Fun in head to tail order +filter_f(_, []) -> + []; +filter_f(Fun, [X | F]) -> + case Fun(X) of + true -> + [X | filter_f(Fun, F)]; + [Y] -> + [Y | filter_f(Fun, F)]; + false -> + filter_f(Fun, F); + [] -> + filter_f(Fun, F); + L when is_list(L) -> + L ++ filter_f(Fun, F) + end. + +%% Call Fun in reverse order, i.e tail to head +%% and reverse list result from fun to match queue order +filter_r(_, []) -> + []; +filter_r(Fun, [X | R0]) -> + R = filter_r(Fun, R0), + case Fun(X) of + true -> + [X | R]; + [Y] -> + [Y | R]; + false -> + R; + [] -> + R; + L when is_list(L) -> + lists:reverse(L, R) + end. + +% How works: +% Filter and map a queue, traverses in queue order. +% Since OTP 24 +% O(len(Q1)) + +%%----------------------------------------------------------------------------- +%% @param Fun the function to be applied to each item in the queue +%% @param Q1 the queue where the function will be applied +%% @returns Returns a queue `Q2' that is the result of calling `Fun(Item)' on all items in `Q1' +%% @doc Returns a queue `Q2' that is the result of calling `Fun(Item)' on all items in `Q1'. +%% If `Fun(Item)' returns `true', `Item' is copied to the result queue. If it returns +%% `false', `Item' is not copied. If it returns `{true, NewItem}', the queue element +%% at this position is replaced with `NewItem' in the result queue. +%% +%% Example 1: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `{[5,4,3],[1,2]}' +%% `2> Queue1 = queue:filtermap(fun (E) -> E > 2 end, Queue).' +%% `{[5],[3,4]}' +%% `3> queue:to_list(Queue1).' +%% `[3,4,5]' +%% `4> Queue1 = queue:filtermap(fun (E) -> {true, E+100} end, Queue).' +%% `{[105,104,103],[101,102]}' +%% `5> queue:to_list(Queue1).' +%% `[101,102,103,104,105]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec filtermap(Fun, Q1) -> Q2 when + Fun :: fun((Item) -> boolean() | {'true', Value}), + Q1 :: queue(Item), + Q2 :: queue(Item | Value), + Item :: term(), + Value :: term(). +filtermap(Fun, {R0, F0}) when is_function(Fun, 1), is_list(R0), is_list(F0) -> + F = lists:filtermap(Fun, F0), + R = filtermap_r(Fun, R0), + if + R =:= [] -> + f2r(F); + F =:= [] -> + r2f(R); + true -> + {R, F} + end; +filtermap(Fun, Q) -> + erlang:error(badarg, [Fun, Q]). + +%% Call Fun in reverse order, i.e tail to head +filtermap_r(_, []) -> + []; +filtermap_r(Fun, [X | R0]) -> + R = filtermap_r(Fun, R0), + case Fun(X) of + true -> + [X | R]; + {true, Y} -> + [Y | R]; + false -> + R + end. + +% How works: +% Fold a function over a queue, in queue order. +% Since OTP 24 +% O(len(Q)) + +%%----------------------------------------------------------------------------- +%% @param Fun the function to be applied to each item and accumulator +%% @param Acc0 the initial accumulator value +%% @param Q the queue over which the function will be folded +%% @returns Returns the final value of the accumulator after folding over the queue +%% @doc Calls `Fun(Item, AccIn)' on successive items `Item' of `Queue', starting with +%% `AccIn == Acc0'. The queue is traversed in queue order, that is, from front to +%% rear. `Fun/2' must return a new accumulator, which is passed to the next call. +%% The function returns the final value of the accumulator. `Acc0' is returned if +%% the queue is empty. +%% +%% Example: +%% `1> queue:fold(fun(X, Sum) -> X + Sum end, 0, queue:from_list([1,2,3,4,5])).' +%% `15' +%% `2> queue:fold(fun(X, Prod) -> X * Prod end, 1, queue:from_list([1,2,3,4,5])).' +%% `120' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec fold(Fun, Acc0, Q :: queue(Item)) -> Acc1 when + Fun :: fun((Item, AccIn) -> AccOut), + Acc0 :: term(), + Acc1 :: term(), + AccIn :: term(), + AccOut :: term(). +fold(Fun, Acc0, {R, F}) when is_function(Fun, 2), is_list(R), is_list(F) -> + Acc1 = lists:foldl(Fun, Acc0, F), + lists:foldr(Fun, Acc1, R); +fold(Fun, Acc0, Q) -> + erlang:error(badarg, [Fun, Acc0, Q]). + +% How works: +% Check if any item satisfies the predicate, traverse in queue order. +% Since OTP 24 +% O(len(Q)) worst case + +%%----------------------------------------------------------------------------- +%% @param Pred the predicate function to apply to each item +%% @param Q the queue to check against the predicate +%% @returns Returns `true' if `Pred(Item)' returns `true' for at least one item `Item' in +%% `Q', otherwise `false'. +%% @doc Returns `true' if `Pred(Item)' returns `true' for at least one item `Item' in +%% `Q', otherwise `false'. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `2> queue:any(fun (E) -> E > 10 end, Queue).' +%% `false' +%% `3> queue:any(fun (E) -> E > 3 end, Queue).' +%% `true' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec any(Pred, Q :: queue(Item)) -> boolean() when + Pred :: fun((Item) -> boolean()). +any(Pred, {R, F}) when is_function(Pred, 1), is_list(R), is_list(F) -> + lists:any(Pred, F) orelse + lists:any(Pred, R); +any(Pred, Q) -> + erlang:error(badarg, [Pred, Q]). + +% How works: +% Check if all items satisfy the predicate, traverse in queue order. +% Since OTP 24 +% O(len(Q)) worst case + +%%----------------------------------------------------------------------------- +%% @param Pred the predicate function to apply to each item +%% @param Q the queue to check against the predicate +%% @returns Returns `true' if `Pred(Item)' returns `true' for all items `Item' in `Q', +%% otherwise `false'. +%% @doc Returns `true' if `Pred(Item)' returns `true' for all items `Item' in `Q', +%% otherwise `false'. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `2> queue:all(fun (E) -> E > 3 end, Queue).' +%% `false' +%% `3> queue:all(fun (E) -> E > 0 end, Queue).' +%% `true' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec all(Pred, Q :: queue(Item)) -> boolean() when + Pred :: fun((Item) -> boolean()). +all(Pred, {R, F}) when is_function(Pred, 1), is_list(R), is_list(F) -> + lists:all(Pred, F) andalso + lists:all(Pred, R); +all(Pred, Q) -> + erlang:error(badarg, [Pred, Q]). + +% How works: +% Delete the first occurrence of an item in the queue, according to queue order. +% Since OTP 24 +% O(len(Q1)) worst case + +%%----------------------------------------------------------------------------- +%% @param Item the item to delete from the queue +%% @param Q1 the queue from which the item will be deleted +%% @returns Returns a copy of `Q1' where the first item matching `Item' is deleted, if there +%% is such an item. +%% @doc Returns a copy of `Q1' where the first item matching `Item' is deleted, if there +%% is such an item. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5]).' +%% `2> Queue1 = queue:delete(3, Queue).' +%% `3> queue:member(3, Queue1).' +%% `false' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec delete(Item, Q1) -> Q2 when + Item :: T, + Q1 :: queue(T), + Q2 :: queue(T), + T :: term(). +delete(Item, {R0, F0} = Q) when is_list(R0), is_list(F0) -> + case delete_front(Item, F0) of + false -> + case delete_rear(Item, R0) of + false -> + Q; + [] -> + f2r(F0); + R1 -> + {R1, F0} + end; + [] -> + r2f(R0); + F1 -> + {R0, F1} + end; +delete(Item, Q) -> + erlang:error(badarg, [Item, Q]). + +% How works: +% Delete the last occurrence of an item in the queue, according to queue order. +% Since OTP 24 +% O(len(Q1)) worst case + +%%----------------------------------------------------------------------------- +%% @param Item the item to delete from the queue +%% @param Q1 the queue from which the item will be deleted +%% @returns Returns a copy of `Q1' where the last item matching `Item' is deleted, if there +%% is such an item. +%% @doc Returns a copy of `Q1' where the last item matching `Item' is deleted, if there +%% is such an item. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,3,5]).' +%% `2> Queue1 = queue:delete_r(3, Queue).' +%% `3> queue:to_list(Queue1).' +%% `[1,2,3,4,5]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec delete_r(Item, Q1) -> Q2 when + Item :: T, + Q1 :: queue(T), + Q2 :: queue(T), + T :: term(). +delete_r(Item, {R0, F0}) when is_list(R0), is_list(F0) -> + {F1, R1} = delete(Item, {F0, R0}), + {R1, F1}; +delete_r(Item, Q) -> + erlang:error(badarg, [Item, Q]). + +delete_front(Item, [Item | Rest]) -> + Rest; +delete_front(Item, [X | Rest]) -> + case delete_front(Item, Rest) of + false -> false; + F -> [X | F] + end; +delete_front(_, []) -> + false. + +delete_rear(Item, [X | Rest]) -> + case delete_rear(Item, Rest) of + false when X =:= Item -> + Rest; + false -> + false; + R -> + [X | R] + end; +delete_rear(_, []) -> + false. + +% How works: +% Delete the first occurrence of an item in the queue matching a predicate, according to queue order. +% Since OTP 24 +% O(len(Q1)) worst case + +%%----------------------------------------------------------------------------- +%% @param Pred the predicate function to apply to each item +%% @param Q1 the queue from which the item will be deleted +%% @returns Returns a copy of `Q1' where the first item for which `Pred' returns `true' is +%% deleted, if there is such an item. +%% @doc Returns a copy of `Q1' where the first item for which `Pred' returns `true' is +%% deleted, if there is such an item. +%% +%% Example: +%% `1> Queue = queue:from_list([100,1,2,3,4,5]).' +%% `2> Queue1 = queue:delete_with(fun (E) -> E > 0, Queue).' +%% `3> queue:to_list(Queue1).' +%% `[1,2,3,4,5]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec delete_with(Pred, Q1) -> Q2 when + Pred :: fun((Item) -> boolean()), + Q1 :: queue(Item), + Q2 :: queue(Item), + Item :: term(). +delete_with(Pred, {R0, F0} = Q) when is_function(Pred, 1), is_list(R0), is_list(F0) -> + case delete_with_front(Pred, F0) of + false -> + case delete_with_rear(Pred, R0) of + false -> + Q; + [] -> + f2r(F0); + R1 -> + {R1, F0} + end; + [] -> + r2f(R0); + F1 -> + {R0, F1} + end; +delete_with(Pred, Q) -> + erlang:error(badarg, [Pred, Q]). + +% How works: +% Delete the last occurrence of an item in the queue matching a predicate, according to queue order. +% Since OTP 24 +% O(len(Q1)) worst case + +%%----------------------------------------------------------------------------- +%% @param Pred the predicate function to apply to each item +%% @param Q1 the queue from which the item will be deleted +%% @returns Returns a copy of `Q1' where the last item for which `Pred' returns `true' is +%% deleted, if there is such an item. +%% @doc Returns a copy of `Q1' where the last item for which `Pred' returns `true' is +%% deleted, if there is such an item. +%% +%% Example: +%% `1> Queue = queue:from_list([1,2,3,4,5,100]).' +%% `2> Queue1 = queue:delete_with_r(fun (E) -> E > 10, Queue).' +%% `3> queue:to_list(Queue1).' +%% `[1,2,3,4,5]' +%% +%% @end +%%----------------------------------------------------------------------------- +-spec delete_with_r(Pred, Q1) -> Q2 when + Pred :: fun((Item) -> boolean()), + Q1 :: queue(Item), + Q2 :: queue(Item), + Item :: term(). +delete_with_r(Pred, {R0, F0}) when is_function(Pred, 1), is_list(R0), is_list(F0) -> + {F1, R1} = delete_with(Pred, {F0, R0}), + {R1, F1}; +delete_with_r(Pred, Q) -> + erlang:error(badarg, [Pred, Q]). + +delete_with_front(Pred, [X | Rest]) -> + case Pred(X) of + true -> + Rest; + false -> + case delete_with_front(Pred, Rest) of + false -> + false; + F -> + [X | F] + end + end; +delete_with_front(_, []) -> + false. + +delete_with_rear(Pred, [X | Rest]) -> + case delete_with_rear(Pred, Rest) of + false -> + case Pred(X) of + true -> + Rest; + false -> + false + end; + R -> + [X | R] + end; +delete_with_rear(_, []) -> + false. + +%%-------------------------------------------------------------------------- +%% Internal workers + +-compile({inline, [{r2f, 1}, {f2r, 1}]}). + +%% Move half of elements from R to F, if there are at least three +r2f([]) -> + {[], []}; +r2f([_] = R) -> + {[], R}; +r2f([Y, X]) -> + {[Y], [X]}; +r2f(List) -> + {RR, FF} = lists:split(length(List) div 2, List), + {RR, lists:reverse(FF, [])}. + +%% Move half of elements from F to R, if there are enough +f2r([]) -> + {[], []}; +f2r([_] = F) -> + {F, []}; +f2r([X, Y]) -> + {[Y], [X]}; +f2r(List) -> + {FF, RR} = lists:split(length(List) div 2, List), + {lists:reverse(RR, []), FF}. diff --git a/tests/libs/estdlib/CMakeLists.txt b/tests/libs/estdlib/CMakeLists.txt index bf3b5b8ae..14961e7fe 100644 --- a/tests/libs/estdlib/CMakeLists.txt +++ b/tests/libs/estdlib/CMakeLists.txt @@ -39,6 +39,7 @@ set(ERLANG_MODULES test_ssl test_string test_proplists + test_queue test_timer test_supervisor test_tcp_socket diff --git a/tests/libs/estdlib/test_queue.erl b/tests/libs/estdlib/test_queue.erl new file mode 100644 index 000000000..569aa9320 --- /dev/null +++ b/tests/libs/estdlib/test_queue.erl @@ -0,0 +1,341 @@ +% +% This file is part of AtomVM. +% +% Copyright 2024 Davide Bettio +% +% 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_queue). + +-export([test/0]). + +-include("etest.hrl"). + +test() -> + ok = test_from_to_list(), + ok = test_new_and_is_queue(), + ok = test_len_and_in(), + ok = test_in_and_from_to_list(), + ok = test_len_and_out(), + ok = test_out_on_empty(), + ok = test_out_r(), + ok = test_in_r(), + ok = test_member(), + ok = test_basic_queue_flow(), + ok = test_get(), + ok = test_get_empty(), + ok = test_get_r(), + ok = test_get_r_empty(), + ok = test_peek(), + ok = test_peek_r(), + ok = test_drop(), + ok = test_drop_r(), + ok = test_reverse(), + ok = test_join(), + ok = test_split(), + ok = test_filter(), + ok = test_filter_replace(), + ok = test_filtermap(get_otp_version()), + ok = test_filtermap_replace(get_otp_version()), + ok = test_fold(get_otp_version()), + ok = test_any(get_otp_version()), + ok = test_all(get_otp_version()), + ok = test_delete(get_otp_version()), + ok = test_delete_with(get_otp_version()), + ok = test_delete_with_r(get_otp_version()), + ok = test_complete_flow(), + ok. + +get_otp_version() -> + case erlang:system_info(machine) of + "BEAM" -> list_to_integer(erlang:system_info(otp_release)); + _ -> atomvm + end. + +test_from_to_list() -> + L = [1, -1, 2, -3], + Q = queue:from_list(L), + ?ASSERT_MATCH(queue:to_list(Q), L), + ok. + +test_new_and_is_queue() -> + Q = queue:new(), + ?ASSERT_MATCH(queue:is_queue(Q), true), + ?ASSERT_MATCH(queue:is_queue(<<"Foo">>), false), + ok. + +test_len_and_in() -> + Q0 = queue:new(), + ?ASSERT_MATCH(queue:len(Q0), 0), + Q1 = queue:in(1, Q0), + ?ASSERT_MATCH(queue:len(Q1), 1), + ok. + +test_len_and_out() -> + Q0 = queue:new(), + Q1 = queue:in(1, Q0), + ?ASSERT_MATCH(queue:len(Q1), 1), + {{value, 1}, Q2} = queue:out(Q1), + ?ASSERT_MATCH(queue:len(Q2), 0), + ok. + +test_in_and_from_to_list() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:in(100, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [1, 2, 3, 4, 5, 100]), + ok. + +test_out_on_empty() -> + Q0 = queue:new(), + ?ASSERT_MATCH(queue:out(Q0), {empty, Q0}), + ok. + +test_in_r() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:in_r(100, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [100, 1, 2, 3, 4, 5]), + ok. + +test_out_r() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + {{value, 5}, Q1} = queue:out_r(Q), + queue:to_list(Q1), + ?ASSERT_MATCH(queue:to_list(Q1), [1, 2, 3, 4]), + ok. + +test_member() -> + L = [1, -1, 2, -3], + Q = queue:from_list(L), + + ?ASSERT_MATCH(queue:member(1, Q), true), + ?ASSERT_MATCH(queue:member(-1, Q), true), + ?ASSERT_MATCH(queue:member(2, Q), true), + ?ASSERT_MATCH(queue:member(-3, Q), true), + ?ASSERT_MATCH(queue:member(20, Q), false), + ?ASSERT_MATCH(queue:member(0, queue:new()), false), + + ok. + +test_basic_queue_flow() -> + Q0 = queue:new(), + Q1 = queue:in(1, Q0), + Q2 = queue:in(2, Q1), + Q3 = queue:in(3, Q2), + + ?ASSERT_MATCH(queue:is_empty(Q3), false), + ?ASSERT_MATCH(queue:len(Q3), 3), + + {V1, O1} = queue:out(Q3), + ?ASSERT_MATCH(V1, {value, 1}), + + {V2, O2} = queue:out(O1), + ?ASSERT_MATCH(V2, {value, 2}), + + {V3, O3} = queue:out(O2), + ?ASSERT_MATCH(V3, {value, 3}), + + ?ASSERT_MATCH(queue:is_empty(O3), true), + + ok. + +test_get() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:get(Q), 1), + ok. + +test_get_empty() -> + Empty = queue:new(), + %queue:get(Empty), + ?ASSERT_ERROR(queue:get(Empty), empty), + ok. + +test_get_r() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:get_r(Q), 5), + ok. + +test_get_r_empty() -> + Empty = queue:new(), + ?ASSERT_ERROR(queue:get_r(Empty), empty), + ok. + +test_peek() -> + ?ASSERT_MATCH(queue:peek(queue:new()), empty), + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:peek(Q), {value, 1}), + ok. + +test_peek_r() -> + ?ASSERT_MATCH(queue:peek_r(queue:new()), empty), + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:peek_r(Q), {value, 5}), + ok. + +test_drop() -> + Q0 = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:drop(Q0), + ?ASSERT_MATCH(queue:to_list(Q1), [2, 3, 4, 5]), + ok. + +test_drop_r() -> + Q0 = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:drop_r(Q0), + ?ASSERT_MATCH(queue:to_list(Q1), [1, 2, 3, 4]), + ok. + +test_reverse() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + QR = queue:reverse(Q), + ?ASSERT_MATCH(queue:to_list(QR), [5, 4, 3, 2, 1]), + ok. + +test_join() -> + Q1 = queue:from_list([1, 3]), + Q2 = queue:from_list([2, 4]), + ?ASSERT_MATCH(queue:to_list(queue:join(Q1, Q2)), [1, 3, 2, 4]), + ok. + +test_split() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + + {Q1, Q2} = queue:split(2, Q), + ?ASSERT_MATCH({queue:to_list(Q1), queue:to_list(Q2)}, {[1, 2], [3, 4, 5]}), + + {Q3, Q4} = queue:split(0, Q), + ?ASSERT_MATCH({queue:to_list(Q3), queue:to_list(Q4)}, {[], [1, 2, 3, 4, 5]}), + + {Q5, Q6} = queue:split(5, Q), + ?ASSERT_MATCH({queue:to_list(Q5), queue:to_list(Q6)}, {[1, 2, 3, 4, 5], []}), + + ok. + +test_filter() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:filter(fun(E) -> E > 2 end, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [3, 4, 5]), + ok. + +test_filter_replace() -> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:filter(fun(E) -> [E, E + 1] end, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [1, 2, 2, 3, 3, 4, 4, 5, 5, 6]), + ok. + +test_filtermap(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:filtermap(fun(E) -> E > 2 end, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [3, 4, 5]), + ok; +test_filtermap(_) -> + ok. + +test_filtermap_replace(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:filtermap(fun(E) -> {true, E + 100} end, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [101, 102, 103, 104, 105]), + ok; +test_filtermap_replace(_) -> + ok. + +test_fold(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:fold(fun(X, Sum) -> X + Sum end, 0, Q), 15), + ok; +test_fold(_) -> + ok. + +test_any(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:any(fun(E) -> E > 10 end, Q), false), + ?ASSERT_MATCH(queue:any(fun(E) -> E > 3 end, Q), true), + ok; +test_any(_) -> + ok. + +test_all(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5]), + ?ASSERT_MATCH(queue:all(fun(E) -> E > 3 end, Q), false), + ?ASSERT_MATCH(queue:all(fun(E) -> E > 0 end, Q), true), + ok; +test_all(_) -> + ok. + +test_delete(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5]), + Q1 = queue:delete(3, Q), + ?ASSERT_MATCH(queue:member(3, Q1), false), + ok; +test_delete(_) -> + ok. + +test_delete_with(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([100, 1, 2, 3, 4, 5]), + Q1 = queue:delete_with(fun(E) -> E > 0 end, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [1, 2, 3, 4, 5]), + ok; +test_delete_with(_) -> + ok. + +test_delete_with_r(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + Q = queue:from_list([1, 2, 3, 4, 5, 100]), + Q1 = queue:delete_with_r(fun(E) -> E > 10 end, Q), + ?ASSERT_MATCH(queue:to_list(Q1), [1, 2, 3, 4, 5]), + ok; +test_delete_with_r(_) -> + ok. + +test_complete_flow() -> + Q0 = queue:new(), + Q1 = queue:in(-2, Q0), + Q2 = queue:in(-1, Q1), + Q3 = queue:in(0, Q2), + Q4 = queue:in(1, Q3), + Q5 = queue:in(2, Q4), + + ?ASSERT_MATCH(queue:len(Q5), 5), + + {V1, Q6} = queue:out(Q5), + ?ASSERT_MATCH(V1, {value, -2}), + + Q7 = queue:in(3, Q6), + Q8 = queue:in(4, Q7), + + {V2, Q9} = queue:out(Q8), + ?ASSERT_MATCH(V2, {value, -1}), + {V3, Q10} = queue:out(Q9), + ?ASSERT_MATCH(V3, {value, 0}), + + Q11 = queue:in(5, Q10), + + ?ASSERT_MATCH(queue:to_list(Q11), [1, 2, 3, 4, 5]), + + ok. diff --git a/tests/libs/estdlib/tests.erl b/tests/libs/estdlib/tests.erl index 32c994f2d..05eacc650 100644 --- a/tests/libs/estdlib/tests.erl +++ b/tests/libs/estdlib/tests.erl @@ -51,6 +51,7 @@ get_tests(_OTPVersion) -> test_logger, test_maps, test_proplists, + test_queue, test_timer, test_spawn, test_supervisor From e9eb96f3f2650512bec585c39ab3238ba7f1a996 Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Wed, 10 Jul 2024 19:32:47 +0200 Subject: [PATCH 07/11] Fix memory leak when handling an out of memory error Add missing free() in error condition, before raising out of memory error. Signed-off-by: Davide Bettio --- CHANGELOG.md | 1 + src/libAtomVM/opcodesswitch.h | 2 ++ 2 files changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index d6914460e..474817354 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -38,6 +38,7 @@ See issue [#1193](https://github.com/atomvm/AtomVM/issues/1193). - Fix error that is raised when a function is undefined - Fix a bug that could yield crashes when functions are sent in messages - Fix bug where failing guards would corrupt x0 and x1 +- Fix a memory leak when raising out of memory error while executing PUT_MAP_ASSOC instruction ## [0.6.2] - 25-05-2024 diff --git a/src/libAtomVM/opcodesswitch.h b/src/libAtomVM/opcodesswitch.h index b73344805..da35dbd69 100644 --- a/src/libAtomVM/opcodesswitch.h +++ b/src/libAtomVM/opcodesswitch.h @@ -5557,6 +5557,7 @@ HOT_FUNC int scheduler_entry_point(GlobalContext *glb) kv[j].value = value; } if (UNLIKELY(!sort_kv_pairs(kv, num_elements, ctx->global))) { + free(kv); RAISE_ERROR(OUT_OF_MEMORY_ATOM); } // @@ -5605,6 +5606,7 @@ HOT_FUNC int scheduler_entry_point(GlobalContext *glb) } case TermCompareMemoryAllocFail: { + free(kv); RAISE_ERROR(OUT_OF_MEMORY_ATOM); } } From f7ef5c9fa251efdcc4332a7edf2536b46e344203 Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Sun, 14 Jul 2024 16:02:32 +0200 Subject: [PATCH 08/11] NIFs: add maps:from_keys/2 NIF This function is heavily used from modules such as sets. So maps such as `#{1 => [], 2 => []}` can be quickly created from a list of keys. Signed-off-by: Davide Bettio --- CHANGELOG.md | 1 + libs/estdlib/src/maps.erl | 12 +++ src/libAtomVM/memory.h | 12 +++ src/libAtomVM/nifs.c | 98 +++++++++++++++++++++ src/libAtomVM/nifs.gperf | 1 + src/libAtomVM/term.h | 25 ++++++ tests/erlang_tests/CMakeLists.txt | 2 + tests/erlang_tests/maps_nifs.erl | 139 ++++++++++++++++++++++++++++++ tests/test.c | 1 + 9 files changed, 291 insertions(+) create mode 100644 tests/erlang_tests/maps_nifs.erl diff --git a/CHANGELOG.md b/CHANGELOG.md index 474817354..846523a5b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Support for USB serial output on ESP32 (needs to be manually enabled) - Support for `lists:filtermap/2` - Support for standard library `queue` module +- Support for `maps:from_keys/2` NIF ### Changed diff --git a/libs/estdlib/src/maps.erl b/libs/estdlib/src/maps.erl index b2f69470d..49e80a835 100644 --- a/libs/estdlib/src/maps.erl +++ b/libs/estdlib/src/maps.erl @@ -52,6 +52,7 @@ filter/2, fold/3, foreach/2, + from_keys/2, map/2, merge/2, remove/2, @@ -385,6 +386,17 @@ foreach(_Fun, Map) when not is_map(Map) -> foreach(_Fun, _Map) -> error(badarg). +%%----------------------------------------------------------------------------- +%% @param List the list of keys of the map that will be created +%% @param Value the value that will be used as value for all map items +%% @returns a map having all provided keys having provided value as value +%% @doc Creates a map with specified keys intialized to given value +%% @end +%%----------------------------------------------------------------------------- +-spec from_keys(list(), term()) -> map(). +from_keys(List, _Value) when is_list(List) -> + erlang:nif_error(undefined). + %%----------------------------------------------------------------------------- %% @param Fun the function to apply to every entry in the map %% @param Map the map to which to apply the map function diff --git a/src/libAtomVM/memory.h b/src/libAtomVM/memory.h index 41a79e1e4..8303c544a 100644 --- a/src/libAtomVM/memory.h +++ b/src/libAtomVM/memory.h @@ -205,6 +205,18 @@ static inline MALLOC_LIKE term *memory_heap_alloc(Heap *heap, size_t size) return allocated; } +/** + * @brief shrinks the heap by size units + * + * @details this function is used when resizing the last item allocated on the heap. + * @param heap the heap that will be shrinked + * @param size the number of terms that will be removed + */ +static inline void memory_heap_trim(Heap *heap, size_t size) +{ + heap->heap_ptr -= size; +} + /** * @brief copies a term to a destination heap * diff --git a/src/libAtomVM/nifs.c b/src/libAtomVM/nifs.c index b13f212ae..250c309ea 100644 --- a/src/libAtomVM/nifs.c +++ b/src/libAtomVM/nifs.c @@ -173,6 +173,7 @@ 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_from_keys(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[]); @@ -706,6 +707,11 @@ static const struct Nif lists_reverse_nif = .base.type = NIFFunctionType, .nif_ptr = nif_lists_reverse }; +static const struct Nif maps_from_keys_nif = +{ + .base.type = NIFFunctionType, + .nif_ptr = nif_maps_from_keys +}; static const struct Nif maps_next_nif = { .base.type = NIFFunctionType, @@ -4373,6 +4379,98 @@ static term nif_lists_reverse(Context *ctx, int argc, term argv[]) return result; } +// assumption: size is at least 1 +static int sort_keys_uniq(term *keys, int size, GlobalContext *global) +{ + int k = size; + while (1 < k) { + int max_pos = 0; + for (int i = 1; i < k; i++) { + term t_max = keys[max_pos]; + term t = keys[i]; + // TODO: not sure if exact is the right choice here + TermCompareResult result = term_compare(t, t_max, TermCompareExact, global); + if (result == TermGreaterThan) { + max_pos = i; + } else if (UNLIKELY(result == TermCompareMemoryAllocFail)) { + return -1; + } + } + if (max_pos != k - 1) { + term tmp = keys[k - 1]; + keys[k - 1] = keys[max_pos]; + keys[max_pos] = tmp; + } + k--; + // keys[k..size] sorted + } + + int j = 1; + term last_seen = keys[0]; + for (int i = 1; i < size; i++) { + if (keys[i] != last_seen) { + last_seen = keys[i]; + keys[j] = last_seen; + j++; + } + } + + return j; +} + +static term nif_maps_from_keys(Context *ctx, int argc, term argv[]) +{ + UNUSED(argc); + + VALIDATE_VALUE(argv[0], term_is_list); + + if (term_is_nil(argv[0])) { + int required_size = TUPLE_SIZE(0) + TERM_MAP_SIZE(0); + if (UNLIKELY(memory_ensure_free_opt(ctx, required_size, MEMORY_CAN_SHRINK) != MEMORY_GC_OK)) { + RAISE_ERROR(OUT_OF_MEMORY_ATOM); + } + return term_alloc_map_maybe_shared(0, term_invalid_term(), &ctx->heap); + } + + int proper; + avm_int_t len = term_list_length(argv[0], &proper); + if (UNLIKELY(!proper)) { + RAISE_ERROR(BADARG_ATOM); + } + + int required_size = TUPLE_SIZE(len) + TERM_MAP_SHARED_SIZE(len); + if (UNLIKELY(memory_ensure_free_with_roots(ctx, required_size, 2, argv, MEMORY_CAN_SHRINK) != MEMORY_GC_OK)) { + RAISE_ERROR(OUT_OF_MEMORY_ATOM); + } + term keys_tuple = term_alloc_tuple(len, &ctx->heap); + + term l = argv[0]; + for (int i = 0; i < len; i++) { + term element = term_get_list_head(l); + term_put_tuple_element(keys_tuple, i, element); + l = term_get_list_tail(l); + } + + term *keys = term_to_term_ptr(keys_tuple); + int uniq = sort_keys_uniq(keys + 1, len, ctx->global); + if (UNLIKELY(uniq < 0)) { + RAISE_ERROR(OUT_OF_MEMORY_ATOM); + } + if (len != uniq) { + term_truncate_boxed(keys_tuple, uniq, &ctx->heap); + len = uniq; + } + + term value = argv[1]; + + term map = term_alloc_map_maybe_shared(len, keys_tuple, &ctx->heap); + for (int i = 0; i < len; i++) { + term_set_map_value(map, i, value); + } + + return map; +} + 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 3101a3099..0ca7ffc6d 100644 --- a/src/libAtomVM/nifs.gperf +++ b/src/libAtomVM/nifs.gperf @@ -145,6 +145,7 @@ 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:from_keys/2, &maps_from_keys_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/term.h b/src/libAtomVM/term.h index e9e8a511f..f926ef6d5 100644 --- a/src/libAtomVM/term.h +++ b/src/libAtomVM/term.h @@ -1616,6 +1616,25 @@ static inline term term_alloc_bin_match_state(term binary_or_state, int slots, H return ((term) boxed_match_state) | TERM_BOXED_VALUE_TAG; } +/** + * @brief truncates last allocated boxed term to given size + * + * @details This function can be used to shrink last allocated boxed term + * @param boxed the boxed term that will be shrinked (it must be the last allocated) + * @param new_size in terms + * @param heap the heap where the term has been allocated + */ +static inline void term_truncate_boxed(term boxed, size_t new_size, Heap *heap) +{ + /* boxed: 10 */ + TERM_DEBUG_ASSERT((t & 0x3) == 0x2); + + term *boxed_value = term_to_term_ptr(boxed); + int size_diff = (boxed_value[0] >> 6) - new_size; + boxed_value[0] = (boxed_value[0] & TERM_BOXED_TAG_MASK) | (new_size << 6); + memory_heap_trim(heap, size_diff); +} + static inline int term_is_map(term t) { if (term_is_boxed(t)) { @@ -1695,6 +1714,12 @@ static inline term term_get_map_value(term map, avm_uint_t pos) return boxed_value[term_get_map_value_offset() + pos]; } +static inline void term_set_map_value(term map, avm_uint_t pos, term value) +{ + term *boxed_value = term_to_term_ptr(map); + boxed_value[term_get_map_value_offset() + pos] = value; +} + static inline int term_find_map_pos(term map, term key, GlobalContext *global) { term keys = term_get_map_keys(map); diff --git a/tests/erlang_tests/CMakeLists.txt b/tests/erlang_tests/CMakeLists.txt index 7b7d54cda..229be4afb 100644 --- a/tests/erlang_tests/CMakeLists.txt +++ b/tests/erlang_tests/CMakeLists.txt @@ -500,6 +500,7 @@ compile_erlang(complex_list_match_xregs) compile_erlang(twentyone_param_fun) compile_erlang(test_fun_to_list) +compile_erlang(maps_nifs) add_custom_target(erlang_test_modules DEPENDS code_load_files @@ -966,4 +967,5 @@ add_custom_target(erlang_test_modules DEPENDS twentyone_param_fun.beam test_fun_to_list.beam + maps_nifs.beam ) diff --git a/tests/erlang_tests/maps_nifs.erl b/tests/erlang_tests/maps_nifs.erl new file mode 100644 index 000000000..ca8104ea6 --- /dev/null +++ b/tests/erlang_tests/maps_nifs.erl @@ -0,0 +1,139 @@ +% +% This file is part of AtomVM. +% +% Copyright 2024 Davide Bettio +% +% 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(maps_nifs). + +-export([start/0, fact/1, make_value/1, get_expected/1, get_list/1]). + +start() -> + test_maps_from_keys(get_otp_version()). + +get_otp_version() -> + case erlang:system_info(machine) of + "BEAM" -> list_to_integer(erlang:system_info(otp_release)); + _ -> atomvm + end. + +test_maps_from_keys(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm +-> + M1 = #{1 => [], 5 => [], 6 => [], 8 => [], 9 => [], 24 => [], 43 => [], 100 => []}, + M1 = maps:from_keys(?MODULE:get_list(1), []), + + M2 = ?MODULE:get_expected(2), + M2 = maps:from_keys(?MODULE:get_list(2), ?MODULE:make_value(0)), + + M3 = maps:from_keys(?MODULE:get_list(3), true), + 4 = map_size(M3), + M3 = ?MODULE:get_expected(3), + + M4 = maps:from_keys(?MODULE:get_list(4), true), + 5 = map_size(M4), + M4 = ?MODULE:get_expected(4), + + M5 = maps:from_keys(?MODULE:get_list(5), ok), + 0 = map_size(M5), + M5 = ?MODULE:get_expected(5), + + 0; +test_maps_from_keys(OTPVersion) -> + % test skipped: maps:from_keys not supported on OTP < 24 + 0. + +fact(0) -> + 1; +fact(N) -> + fact(N - 1) * N. + +make_value(N) -> + #{ + a => {fact(N), "hello"}, + b => {test, "world", fact(N + 5)}, + c => {<<"a">>, fact(N + 4), <<"c">>} + }. + +get_list(1) -> + [100, ?MODULE:fact(1), 9, ?MODULE:fact(3), 8, ?MODULE:fact(4), 43, 5]; +get_list(2) -> + get_list(1); +get_list(3) -> + [5, 1, 2, fact(0), 4]; +get_list(4) -> + [5, 1, 2, fact(0), 4, 5, 1, fact(1), 9]; +get_list(5) -> + []. + +get_expected(2) -> + #{ + 1 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 5 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 6 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 8 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 9 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 24 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 43 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + }, + 100 => + #{ + c => {<<"a">>, 24, <<"c">>}, + a => {1, "hello"}, + b => {test, "world", 120} + } + }; +get_expected(3) -> + #{1 => true, 2 => true, 4 => true, 5 => true}; +get_expected(4) -> + #{1 => true, 2 => true, 4 => true, 5 => true, 9 => true}; +get_expected(5) -> + #{}. diff --git a/tests/test.c b/tests/test.c index d1409e0e9..23f3e0644 100644 --- a/tests/test.c +++ b/tests/test.c @@ -531,6 +531,7 @@ struct Test tests[] = { TEST_CASE(twentyone_param_fun), TEST_CASE(test_fun_to_list), + TEST_CASE(maps_nifs), // TEST CRASHES HERE: TEST_CASE(memlimit), From a2ee01326180f6880a1adf454dcaea727c24cf89 Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Thu, 18 Jul 2024 13:54:30 +0200 Subject: [PATCH 09/11] Add sets module Code has been taken from github.com/erlang/otp/blob/master/lib/stdlib/src/sets.erl (main branch). Few changes have been made to match documentation format, and to make filter and map functions working with all erlang compiler versions we support. Tests for sets have been excluded on certain OTP versions since we use maps:from_keys that is available since OTP 24. Signed-off-by: Davide Bettio --- CHANGELOG.md | 1 + libs/estdlib/src/CMakeLists.txt | 1 + libs/estdlib/src/sets.erl | 544 ++++++++++++++++++++++++++++++ tests/libs/estdlib/CMakeLists.txt | 1 + tests/libs/estdlib/test_sets.erl | 186 ++++++++++ tests/libs/estdlib/tests.erl | 7 +- 6 files changed, 739 insertions(+), 1 deletion(-) create mode 100644 libs/estdlib/src/sets.erl create mode 100644 tests/libs/estdlib/test_sets.erl diff --git a/CHANGELOG.md b/CHANGELOG.md index 846523a5b..bcb2e1f12 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Support for `lists:filtermap/2` - Support for standard library `queue` module - Support for `maps:from_keys/2` NIF +- Support for standard library `sets` module ### Changed diff --git a/libs/estdlib/src/CMakeLists.txt b/libs/estdlib/src/CMakeLists.txt index 233ff78e9..cc2f487f0 100644 --- a/libs/estdlib/src/CMakeLists.txt +++ b/libs/estdlib/src/CMakeLists.txt @@ -50,6 +50,7 @@ set(ERLANG_MODULES logger_std_h proplists queue + sets socket ssl string diff --git a/libs/estdlib/src/sets.erl b/libs/estdlib/src/sets.erl new file mode 100644 index 000000000..3f598dda0 --- /dev/null +++ b/libs/estdlib/src/sets.erl @@ -0,0 +1,544 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% +%% +%% SPDX-License-Identifier: Apache-2.0 +%% + +% +% This is shrinked down version of OTP sets module, that supports just the new format +% + +-module(sets). +-compile({no_auto_import, [size/1]}). + +-export_type([set/0, set/1]). + +-export([ + new/0, new/1, + is_set/1, + size/1, + is_empty/1, + from_list/1, + from_list/2, + is_equal/2, + to_list/1, + is_element/2, + add_element/2, + del_element/2, + union/1, + union/2, + intersection/1, + intersection/2, + is_disjoint/2, + subtract/2, + is_subset/2, + fold/3, + filter/2, + map/2, + filtermap/2 +]). + +-define(VALUE, []). + +-type set() :: set(_). + +-opaque set(Element) :: #{Element => ?VALUE}. + +%%----------------------------------------------------------------------------- +%% @returns Returns a new empty set. +%% @doc Returns a new empty set using the v2 format (a map). +%% @end +%%----------------------------------------------------------------------------- +-spec new() -> set(none()). +new() -> #{}. + +%%----------------------------------------------------------------------------- +%% @param Version must be `{version, 2}' +%% @returns Returns a new empty set. +%% @doc Returns a new empty set (only v2 format is supported). +%% @end +%%----------------------------------------------------------------------------- +-spec new([{version, 2}]) -> set(none()). +new([{version, 2}] = _Version) -> + new(). + +%%----------------------------------------------------------------------------- +%% @param Set the term that will be checked +%% @returns Return `true' if `Set' is a set of elements, else `false'. +%% @doc Returns `true' if `Set' appears to be a set of elements, otherwise `false'. +%% +%% Note that the test is shallow and will return `true' for any term that coincides with +%% the possible representations of a set. +%% @end +%%----------------------------------------------------------------------------- +-spec is_set(Set) -> boolean() when + Set :: term(). +is_set(#{}) -> true; +is_set(_) -> false. + +%%----------------------------------------------------------------------------- +%% @param Set the set for which size will be returned +%% @returns Return the number of elements in `Set'. +%% @doc Returns the number of elements in `Set'. +%% @end +%%----------------------------------------------------------------------------- +-spec size(Set) -> non_neg_integer() when + Set :: set(). +size(#{} = S) -> map_size(S). + +%%----------------------------------------------------------------------------- +%% @param Set the set to be checked for emptiness +%% @returns Returns `true' if `Set' is an empty set, otherwise `false'. +%% @doc Returns `true' if `Set' is an empty set, otherwise `false'. +%% @end +%%----------------------------------------------------------------------------- +-spec is_empty(Set) -> boolean() when + Set :: set(). +is_empty(#{} = S) -> map_size(S) =:= 0. + +%%----------------------------------------------------------------------------- +%% @param List the list of items that is used for building the set +%% @returns Returns a set of the elements in `List'. +%% @doc Builds a set from the elements in `List'. +%% @end +%%----------------------------------------------------------------------------- +-spec from_list(List) -> Set when + List :: [Element], + Set :: set(Element). +from_list(Ls) -> + maps:from_keys(Ls, ?VALUE). + +%%----------------------------------------------------------------------------- +%% @param List the list to be converted to a set +%% @param Version only version 2 is supported +%% @returns Returns a set of the elements in `List' at the given version. +%% @doc Builds a set from the elements in `List' using the specified version. Only `v2' +%% format is supported. +%% @end +%%----------------------------------------------------------------------------- +-spec from_list(List, Version :: [{version, 2}]) -> Set when + List :: [Element], + Set :: set(Element). +from_list(Ls, [{version, 2}]) -> + from_list(Ls). + +%%----------------------------------------------------------------------------- +%% @param Set1 first set to be checked for equality +%% @param Set2 second set to be checked for equality +%% @returns Return `true' if `Set1' and `Set2' contain the same elements, otherwise `false'. +%% @doc Returns `true' if `Set1' and `Set2' are equal, that is when every element of one +%% set is also a member of the respective other set, otherwise `false'. +%% +%% @end +%%----------------------------------------------------------------------------- +-spec is_equal(Set1, Set2) -> boolean() when + Set1 :: set(), + Set2 :: set(). +is_equal(S1, S2) -> + case map_size(S1) =:= map_size(S2) of + true when S1 =:= S2 -> + true; + true -> + canonicalize_v2(S1) =:= canonicalize_v2(S2); + false -> + false + end. + +canonicalize_v2(S) -> + from_list(to_list(S)). + +%%----------------------------------------------------------------------------- +%% @param Set the set to be converted to a list +%% @returns Return the elements in Set as a list. +%% @doc Returns the elements of `Set' as a list. The order of the returned elements is +%% undefined. +%% +%% @end +%%----------------------------------------------------------------------------- +-spec to_list(Set) -> List when + Set :: set(Element), + List :: [Element]. +to_list(#{} = S) -> + maps:keys(S). + +%%----------------------------------------------------------------------------- +%% @param Element the element to check +%% @param Set the set to check against +%% @returns Returns `true' if `Element' is an element of `Set', otherwise `false'. +%% @doc Return `true' if `Element' is an element of `Set', else `false'. +%% @end +%%----------------------------------------------------------------------------- +-spec is_element(Element, Set) -> boolean() when + Set :: set(Element). +is_element(E, #{} = S) -> + case S of + #{E := _} -> true; + _ -> false + end. + +%%----------------------------------------------------------------------------- +%% @param Element the element to add +%% @param Set1 the set to add the element to +%% @returns Returns a new set formed from `Set1' with `Element' inserted. +%% @doc Return `Set1' with `Element' inserted in it. +%% @end +%%----------------------------------------------------------------------------- +-spec add_element(Element, Set1) -> Set2 when + Set1 :: set(Element), + Set2 :: set(Element). +add_element(E, #{} = S) -> + S#{E => ?VALUE}. + +%%----------------------------------------------------------------------------- +%% @param Element the element to remove +%% @param Set1 the set to remove the element from +%% @returns Returns `Set1', but with `Element' removed. +%% @doc Return `Set1' but with `Element' removed. +%% @end +%%----------------------------------------------------------------------------- +-spec del_element(Element, Set1) -> Set2 when + Set1 :: set(Element), + Set2 :: set(Element). +del_element(E, #{} = S) -> + maps:remove(E, S). + +%%----------------------------------------------------------------------------- +%% @param Set1 the first set +%% @param Set2 the second set +%% @returns Returns the merged (union) set of `Set1' and `Set2'. +%% @doc Return the union of `Set1' and `Set2'. +%% @end +%%----------------------------------------------------------------------------- +-spec union(Set1, Set2) -> Set3 when + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). +union(#{} = S1, #{} = S2) -> + maps:merge(S1, S2). + +%%----------------------------------------------------------------------------- +%% @param SetList the list of sets +%% @returns Returns the merged (union) set of the list of sets. +%% @doc Return the union of the list of sets. +%% @end +%%----------------------------------------------------------------------------- +-spec union(SetList) -> Set when + SetList :: [set(Element)], + Set :: set(Element). +union([S1, S2 | Ss]) -> + union1(union(S1, S2), Ss); +union([S]) -> + S; +union([]) -> + new(). + +-spec union1(set(E), [set(E)]) -> set(E). +union1(S1, [S2 | Ss]) -> + union1(union(S1, S2), Ss); +union1(S1, []) -> + S1. + +%%----------------------------------------------------------------------------- +%% @param Set1 the first set +%% @param Set2 the second set +%% @returns Returns the intersection of `Set1' and `Set2'. +%% @doc Return the intersection of `Set1' and `Set2'. +%% @end +%%----------------------------------------------------------------------------- +-spec intersection(Set1, Set2) -> Set3 when + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). +intersection(#{} = S1, #{} = S2) -> + case map_size(S1) < map_size(S2) of + true -> + Next = maps:next(maps:iterator(S1)), + intersection_heuristic(Next, [], [], floor(map_size(S1) * 0.75), S1, S2); + false -> + Next = maps:next(maps:iterator(S2)), + intersection_heuristic(Next, [], [], floor(map_size(S2) * 0.75), S2, S1) + end. + +%% If we are keeping more than 75% of the keys, then it is +%% cheaper to delete them. Stop accumulating and start deleting. +intersection_heuristic(Next, _Keep, Delete, 0, Acc, Reference) -> + intersection_decided(Next, remove_keys(Delete, Acc), Reference); +intersection_heuristic({Key, _Value, Iterator}, Keep, Delete, KeepCount, Acc, Reference) -> + Next = maps:next(Iterator), + case Reference of + #{Key := _} -> + intersection_heuristic(Next, [Key | Keep], Delete, KeepCount - 1, Acc, Reference); + _ -> + intersection_heuristic(Next, Keep, [Key | Delete], KeepCount, Acc, Reference) + end; +intersection_heuristic(none, Keep, _Delete, _Count, _Acc, _Reference) -> + maps:from_keys(Keep, ?VALUE). + +intersection_decided({Key, _Value, Iterator}, Acc0, Reference) -> + Acc1 = + case Reference of + #{Key := _} -> Acc0; + #{} -> maps:remove(Key, Acc0) + end, + intersection_decided(maps:next(Iterator), Acc1, Reference); +intersection_decided(none, Acc, _Reference) -> + Acc. + +remove_keys([K | Ks], Map) -> remove_keys(Ks, maps:remove(K, Map)); +remove_keys([], Map) -> Map. + +%%----------------------------------------------------------------------------- +%% @param SetList the non-empty list of sets +%% @returns Returns the intersection of the non-empty list of sets. +%% @doc Return the intersection of the list of sets. +%% @end +%%----------------------------------------------------------------------------- +-spec intersection(SetList) -> Set when + SetList :: [set(Element), ...], + Set :: set(Element). +intersection([S1, S2 | Ss]) -> + intersection1(intersection(S1, S2), Ss); +intersection([S]) -> + S. + +-spec intersection1(set(E), [set(E)]) -> set(E). +intersection1(S1, [S2 | Ss]) -> + intersection1(intersection(S1, S2), Ss); +intersection1(S1, []) -> + S1. + +%%----------------------------------------------------------------------------- +%% @param Set1 the first set +%% @param Set2 the second set +%% @returns Returns `true' if `Set1' and `Set2' are disjoint (have no elements in common), +%% otherwise `false'. +%% @doc Check whether `Set1' and `Set2' are disjoint. +%% @end +%%----------------------------------------------------------------------------- +-spec is_disjoint(Set1, Set2) -> boolean() when + Set1 :: set(Element), + Set2 :: set(Element). +is_disjoint(#{} = S1, #{} = S2) -> + if + map_size(S1) < map_size(S2) -> + is_disjoint_1(S2, maps:iterator(S1)); + true -> + is_disjoint_1(S1, maps:iterator(S2)) + end. + +is_disjoint_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> false; + #{} -> is_disjoint_1(Set, NextIter) + end; + none -> + true + end. + +%%----------------------------------------------------------------------------- +%% @param Set1 the first set +%% @param Set2 the second set +%% @returns Returns only the elements of `Set1' that are not also elements of `Set2'. +%% @doc Return all and only the elements of Set1 which are not also in Set2. +%% @end +%%----------------------------------------------------------------------------- +-spec subtract(Set1, Set2) -> Set3 when + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). + +subtract(#{} = LHS, #{} = RHS) -> + LSize = map_size(LHS), + RSize = map_size(RHS), + + case RSize =< (LSize div 4) of + true -> + %% If we're guaranteed to keep more than 75% of the keys, it's + %% always cheaper to delete them one-by-one from the start. + Next = maps:next(maps:iterator(RHS)), + subtract_decided(Next, LHS, RHS); + false -> + %% We might delete more than 25% of the keys. Dynamically + %% transition to deleting elements one-by-one if we can determine + %% that we'll keep more than 75%. + KeepThreshold = (LSize * 3) div 4, + Next = maps:next(maps:iterator(LHS)), + subtract_heuristic(Next, [], [], KeepThreshold, LHS, RHS) + end. + +subtract_heuristic(Next, _Keep, Delete, 0, Acc, Reference) -> + %% We've kept more than 75% of the keys, transition to removing them + %% one-by-one. + subtract_decided(Next, remove_keys(Delete, Acc), Reference); +subtract_heuristic( + {Key, _Value, Iterator}, + Keep, + Delete, + KeepCount, + Acc, + Reference +) -> + Next = maps:next(Iterator), + case Reference of + #{Key := _} -> + subtract_heuristic( + Next, + Keep, + [Key | Delete], + KeepCount, + Acc, + Reference + ); + _ -> + subtract_heuristic( + Next, + [Key | Keep], + Delete, + KeepCount - 1, + Acc, + Reference + ) + end; +subtract_heuristic(none, Keep, _Delete, _Count, _Acc, _Reference) -> + maps:from_keys(Keep, ?VALUE). + +subtract_decided({Key, _Value, Iterator}, Acc, Reference) -> + case Reference of + #{Key := _} -> + subtract_decided( + maps:next(Iterator), + maps:remove(Key, Acc), + Reference + ); + _ -> + subtract_decided(maps:next(Iterator), Acc, Reference) + end; +subtract_decided(none, Acc, _Reference) -> + Acc. + +%%----------------------------------------------------------------------------- +%% @param Set1 the first set +%% @param Set2 the second set +%% @returns Returns `true' when every element of `Set1' is also a member of `Set2', +%% otherwise `false'. +%% @doc Return 'true' when every element of Set1 is also a member of Set2, else 'false'. +%% @end +%%----------------------------------------------------------------------------- +-spec is_subset(Set1, Set2) -> boolean() when + Set1 :: set(Element), + Set2 :: set(Element). + +is_subset(#{} = S1, #{} = S2) -> + if + map_size(S1) > map_size(S2) -> + false; + true -> + is_subset_1(S2, maps:iterator(S1)) + end. + +is_subset_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> is_subset_1(Set, NextIter); + #{} -> false + end; + none -> + true + end. + +%%----------------------------------------------------------------------------- +%% @param Fun the function to fold over the elements of the set +%% @param Accumulator the initial accumulator value +%% @param Set the set to fold over +%% @returns Returns the final value of the accumulator after folding the function +%% over every element in the set. +%% @doc Fold function Fun over all elements in Set and return Accumulator. +%% @end +%%----------------------------------------------------------------------------- +-spec fold(Function, Acc0, Set) -> Acc1 when + Function :: fun((Element, AccIn) -> AccOut), + Set :: set(Element), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc. +fold(F, Acc, #{} = D) when is_function(F, 2) -> + fold_1(F, Acc, maps:iterator(D)). + +fold_1(Fun, Acc, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + fold_1(Fun, Fun(K, Acc), NextIter); + none -> + Acc + end. + +%%----------------------------------------------------------------------------- +%% @param Pred the boolean function to filter elements with +%% @param Set1 the set to filter +%% @returns Returns a set containing elements of `Set1' that satisfy the boolean +%% function `Fun'. The evaluation order is undefined. +%% @doc Filter Set with Fun. +%% @end +%%----------------------------------------------------------------------------- +-spec filter(Pred, Set1) -> Set2 when + Pred :: fun((Element) -> boolean()), + Set1 :: set(Element), + Set2 :: set(Element). +filter(F, #{} = D) when is_function(F, 1) -> + % %% For this purpose, it is more efficient to use + % %% maps:from_keys than a map comprehension. + % maps:from_keys([K || K := _ <- D, F(K)], ?VALUE). + maps:filter(fun(K, _V) -> F(K) end, D). + +%%----------------------------------------------------------------------------- +%% @param Fun the mapping function +%% @param Set1 the set to map over +%% @returns Returns a set containing elements of `Set1' that are mapped using `Fun'. +%% @doc Map Set with Fun. +%% @end +%%----------------------------------------------------------------------------- +-spec map(Fun, Set1) -> Set2 when + Fun :: fun((Element1) -> Element2), + Set1 :: set(Element1), + Set2 :: set(Element2). +map(F, #{} = D) when is_function(F, 1) -> + % %% For this purpose, it is more efficient to use + % %% maps:from_keys than a map comprehension. + % maps:from_keys([F(K) || K := _ <- D], ?VALUE). + maps:from_keys(lists:map(fun(K) -> F(K) end, maps:keys(D)), ?VALUE). + +% Since OTP 27 + +%%----------------------------------------------------------------------------- +%% @param Fun the filter and map fun +%% @param Set1 the set to filter and map over +%% @returns Returns a set containing elements of `Set1' that are filtered and mapped using `Fun'. +%% @doc Filters and maps elements in `Set1' with function `Fun'. +%% @end +%%----------------------------------------------------------------------------- +-spec filtermap(Fun, Set1) -> Set2 when + Fun :: fun((Element1) -> boolean() | {true, Element2}), + Set1 :: set(Element1), + Set2 :: set(Element1 | Element2). +filtermap(F, #{} = D) when is_function(F, 1) -> + maps:from_keys(lists:filtermap(F, to_list(D)), ?VALUE). diff --git a/tests/libs/estdlib/CMakeLists.txt b/tests/libs/estdlib/CMakeLists.txt index 14961e7fe..2dfe988bc 100644 --- a/tests/libs/estdlib/CMakeLists.txt +++ b/tests/libs/estdlib/CMakeLists.txt @@ -35,6 +35,7 @@ set(ERLANG_MODULES test_logger test_maps test_net + test_sets test_spawn test_ssl test_string diff --git a/tests/libs/estdlib/test_sets.erl b/tests/libs/estdlib/test_sets.erl new file mode 100644 index 000000000..bd9648edc --- /dev/null +++ b/tests/libs/estdlib/test_sets.erl @@ -0,0 +1,186 @@ +% +% This file is part of AtomVM. +% +% Copyright 2024 Davide Bettio +% +% 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_sets). + +-export([test/0]). + +-include("etest.hrl"). + +test() -> + ok = test_from_list(), + ok = test_is_set(), + ok = test_size(), + ok = test_is_equal(), + ok = test_is_element(), + ok = test_add_element(), + ok = test_del_element(), + ok = test_union(), + ok = test_intersection(), + ok = test_subtract(), + ok = test_is_disjoint(), + ok = test_is_subset(), + ok = test_filter(), + ok = test_map(), + ok = test_filtermap(), + ok. + +test_from_list() -> + ?ASSERT_MATCH(sets:from_list([ok, <<"hello">>], [{version, 2}]), #{ok => [], <<"hello">> => []}), + ok. + +test_is_set() -> + ?ASSERT_MATCH(sets:is_set(sets:from_list([ok, <<"hello">>])), true), + ?ASSERT_MATCH(sets:is_set({}), false), + ok. + +test_size() -> + ?ASSERT_MATCH(sets:size(sets:from_list([ok, <<"hello">>])), 2), + ?ASSERT_MATCH(sets:size(sets:from_list([])), 0), + ok. + +test_is_equal() -> + ?ASSERT_MATCH(sets:is_equal(sets:from_list([1, 2]), sets:from_list([1, 2])), true), + ?ASSERT_MATCH(sets:is_equal(sets:from_list([1, 2]), sets:from_list([1, 3])), false), + ?ASSERT_MATCH(sets:is_equal(sets:from_list([1, 2]), sets:from_list([1, 2.0])), false), + ?ASSERT_MATCH(sets:is_equal(sets:from_list([1, 2]), #{1 => true, 2 => true}), true), + ?ASSERT_MATCH(sets:is_equal(sets:from_list([1, 2]), #{1 => true, 3 => true}), false), + ok. + +test_is_element() -> + ?ASSERT_MATCH(sets:is_element(1, sets:from_list([1, 2])), true), + ?ASSERT_MATCH(sets:is_element(1, sets:from_list([1.0, 3])), false), + ?ASSERT_MATCH(sets:is_element(5, sets:from_list([1, 2])), false), + ?ASSERT_MATCH(sets:is_element(7, sets:from_list([])), false), + ok. + +test_add_element() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:add_element(10, sets:from_list([20, 30])), + sets:from_list([10, 20, 30]) + ), + true + ), + ok. + +test_del_element() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:del_element(30, sets:from_list([20, 30])), + sets:from_list([20]) + ), + true + ), + ?ASSERT_MATCH( + sets:is_equal( + sets:del_element(-1, sets:from_list([1, 2])), + sets:from_list([1, 2]) + ), + true + ), + ?ASSERT_MATCH( + sets:is_equal( + sets:del_element(1, sets:from_list([])), + sets:from_list([]) + ), + true + ), + ok. + +test_union() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:union(sets:from_list([1, 2, 3]), sets:from_list([4, 5])), + sets:from_list([1, 2, 3, 4, 5]) + ), + true + ), + ok. + +test_intersection() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:intersection(sets:from_list([1, 2, 3]), sets:from_list([0, 2, 3, 7])), + sets:from_list([2, 3]) + ), + true + ), + ok. + +test_subtract() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:subtract(sets:from_list([1, 2, 3, 4]), sets:from_list([2, 3])), + sets:from_list([1, 4]) + ), + true + ), + ok. + +test_is_disjoint() -> + ?ASSERT_MATCH(sets:is_disjoint(sets:from_list([1, 2, 3]), sets:from_list([4, 5, 6])), true), + ?ASSERT_MATCH(sets:is_disjoint(sets:from_list([1, 2, 3]), sets:from_list([3.0, 4])), true), + ?ASSERT_MATCH(sets:is_disjoint(sets:from_list([1, 2]), sets:from_list([2, 3])), false), + ok. + +test_is_subset() -> + ?ASSERT_MATCH(sets:is_subset(sets:from_list([2, 3]), sets:from_list([1, 2, 3, 4])), true), + ?ASSERT_MATCH(sets:is_subset(sets:from_list([2.0, 3]), sets:from_list([1, 2, 3, 4])), false), + ?ASSERT_MATCH(sets:is_subset(sets:from_list([-1]), sets:from_list([1, 2, 3, 4])), false), + ok. + +test_filter() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:filter(fun(X) -> X < 3 end, sets:from_list([1, 2, 3, 4, 5, 6])), + sets:from_list([1, 2]) + ), + true + ), + ok. + +test_map() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:map(fun(X) -> X * 2 end, sets:from_list([1, 3, 5])), + sets:from_list([2, 6, 10]) + ), + true + ), + ok. + +test_filtermap() -> + ?ASSERT_MATCH( + sets:is_equal( + sets:filtermap( + fun(X) -> + case X rem 2 of + 0 -> {true, X div 2}; + _ -> false + end + end, + sets:from_list([1, 2, 3, 4, 5]) + ), + sets:from_list([1, 2]) + ), + true + ), + ok. diff --git a/tests/libs/estdlib/tests.erl b/tests/libs/estdlib/tests.erl index 05eacc650..21de828b8 100644 --- a/tests/libs/estdlib/tests.erl +++ b/tests/libs/estdlib/tests.erl @@ -34,8 +34,13 @@ get_otp_version() -> end. get_tests(OTPVersion) when - (is_integer(OTPVersion) andalso OTPVersion >= 24) orelse OTPVersion == atomvm + (is_integer(OTPVersion) andalso OTPVersion >= 27) orelse OTPVersion == atomvm -> + [test_tcp_socket, test_udp_socket, test_net, test_ssl, test_sets | get_tests(undefined)]; +get_tests(OTPVersion) when + (is_integer(OTPVersion) andalso OTPVersion >= 24) +-> + % test_sets heavily relies on is_equal that is from OTP-27 [test_tcp_socket, test_udp_socket, test_net, test_ssl | get_tests(undefined)]; get_tests(_OTPVersion) -> [ From 90249e42ce3a3dbecba7a648d63024135905f5bf Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Sat, 20 Jul 2024 11:08:16 +0200 Subject: [PATCH 10/11] Prepare v0.6.3 release Signed-off-by: Davide Bettio --- CHANGELOG.md | 2 +- version.cmake | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bcb2e1f12..0723619b5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,7 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [0.6.3] - Unreleased +## [0.6.3] - 20-07-2024 ### Added diff --git a/version.cmake b/version.cmake index 9cca5c103..aa3111da0 100644 --- a/version.cmake +++ b/version.cmake @@ -20,4 +20,4 @@ # Please, keep also in sync src/libAtomVM/atomvm_version.h set(ATOMVM_BASE_VERSION "0.6.3") -set(ATOMVM_DEV TRUE) +set(ATOMVM_DEV FALSE) From 81923c446360f77e67715fd489a6f207f3443cf0 Mon Sep 17 00:00:00 2001 From: Davide Bettio Date: Sat, 20 Jul 2024 18:05:46 +0200 Subject: [PATCH 11/11] Fix release workflows (build-libraries.yaml/build-linux-artifacts.yaml) Revert 85ca4ce078f7d1e18e373998836b18087b40f196 for the mentioned files. Signed-off-by: Davide Bettio --- .github/workflows/build-libraries.yaml | 8 ++++++-- .github/workflows/build-linux-artifacts.yaml | 21 +++++++++++++++----- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/.github/workflows/build-libraries.yaml b/.github/workflows/build-libraries.yaml index 2bd2e7235..1eec21986 100644 --- a/.github/workflows/build-libraries.yaml +++ b/.github/workflows/build-libraries.yaml @@ -16,8 +16,7 @@ permissions: jobs: build-libraries: - runs-on: "ubuntu-24.04" - container: erlang:27 + runs-on: "ubuntu-22.04" strategy: fail-fast: false @@ -27,6 +26,11 @@ jobs: with: submodules: 'recursive' + - uses: erlef/setup-beam@v1 + with: + otp-version: "24" + elixir-version: "1.11" + - name: "APT update" run: sudo apt update -y diff --git a/.github/workflows/build-linux-artifacts.yaml b/.github/workflows/build-linux-artifacts.yaml index 1a73c3fbe..e45c781bc 100644 --- a/.github/workflows/build-linux-artifacts.yaml +++ b/.github/workflows/build-linux-artifacts.yaml @@ -14,27 +14,38 @@ on: permissions: contents: write +env: + otp_version: 24 + elixir_version: 1.14 + jobs: compile_tests: - runs-on: ubuntu-24.04 - container: erlang:27 + runs-on: ubuntu-22.04 steps: - name: Checkout repo uses: actions/checkout@v4 + - uses: erlef/setup-beam@v1 + with: + otp-version: ${{ env.otp_version }} + elixir-version: ${{ env.elixir_version }} + - name: apt update run: sudo apt update - name: Install required packages - run: sudo apt install -y cmake gperf zlib1g-dev ninja-build + run: sudo apt install -y gperf - name: Compile test modules run: | set -e mkdir build_tests cd build_tests - cmake .. -G Ninja -DAVM_WARNINGS_ARE_ERRORS=ON - ninja erlang_test_modules test_estdlib test_eavmlib test_alisp + cmake .. + make erlang_test_modules + make test_estdlib + make test_eavmlib + make test_alisp - name: Upload test modules uses: actions/upload-artifact@v4