diff --git a/CHANGELOG.md b/CHANGELOG.md index 3a5f4cd0e..ac728c250 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added - Added a limited implementation of the OTP `ets` interface - Added `code:all_loaded/0` and `code:all_available/0` +- Partial support for `erlang:fun_info/2` ## [0.6.5] - 2024-10-15 diff --git a/libs/estdlib/src/erlang.erl b/libs/estdlib/src/erlang.erl index 581753b7c..25999b702 100644 --- a/libs/estdlib/src/erlang.erl +++ b/libs/estdlib/src/erlang.erl @@ -67,6 +67,7 @@ float_to_binary/2, float_to_list/1, float_to_list/2, + fun_info/2, integer_to_binary/1, integer_to_binary/2, integer_to_list/1, @@ -761,6 +762,17 @@ float_to_list(_Float) -> float_to_list(_Float, _Options) -> erlang:nif_error(undefined). +%%----------------------------------------------------------------------------- +%% @param Fun Function to get information about +%% @param Info A list of atoms specifying the information to return. +%% Available atoms are: module, name, arity, type +%% @returns Requested information about the function as a list of tuples. +%% @doc Returns information about the function `Fun' in unspecified order. +%% @end +%%----------------------------------------------------------------------------- +fun_info(_Fun, _Info) -> + erlang:nif_error(undefined). + %%----------------------------------------------------------------------------- %% @param Integer integer to convert to a binary %% @returns a binary with a text representation of the integer diff --git a/src/libAtomVM/defaultatoms.c b/src/libAtomVM/defaultatoms.c index f10d24293..1e5916c61 100644 --- a/src/libAtomVM/defaultatoms.c +++ b/src/libAtomVM/defaultatoms.c @@ -161,6 +161,11 @@ static const char *const cast_atom = "\x5" "$cast"; static const char *const unicode_atom = "\x7" "unicode"; static const char *const global_atom = "\x6" "global"; +static const char *const type_atom = "\x4" "type"; +static const char *const name_atom = "\x4" "name"; +static const char *const arity_atom = "\x5" "arity"; +static const char *const external_atom = "\x8" "external"; +static const char *const local_atom = "\x5" "local"; void defaultatoms_init(GlobalContext *glb) { @@ -308,6 +313,12 @@ void defaultatoms_init(GlobalContext *glb) ok &= globalcontext_insert_atom(glb, global_atom) == GLOBAL_ATOM_INDEX; + ok &= globalcontext_insert_atom(glb, type_atom) == TYPE_ATOM_INDEX; + ok &= globalcontext_insert_atom(glb, name_atom) == NAME_ATOM_INDEX; + ok &= globalcontext_insert_atom(glb, arity_atom) == ARITY_ATOM_INDEX; + ok &= globalcontext_insert_atom(glb, external_atom) == EXTERNAL_ATOM_INDEX; + ok &= globalcontext_insert_atom(glb, local_atom) == LOCAL_ATOM_INDEX; + if (!ok) { AVM_ABORT(); } diff --git a/src/libAtomVM/defaultatoms.h b/src/libAtomVM/defaultatoms.h index 285ee4f0e..578634579 100644 --- a/src/libAtomVM/defaultatoms.h +++ b/src/libAtomVM/defaultatoms.h @@ -171,7 +171,14 @@ extern "C" { #define GLOBAL_ATOM_INDEX 111 -#define PLATFORM_ATOMS_BASE_INDEX 112 +#define TYPE_ATOM_INDEX 112 +#define NAME_ATOM_INDEX 113 +#define ARITY_ATOM_INDEX 114 +#define EXTERNAL_ATOM_INDEX 115 +#define LOCAL_ATOM_INDEX 116 + +// Defines the first index for platform specific atoms, should always be last in the list +#define PLATFORM_ATOMS_BASE_INDEX 117 #define FALSE_ATOM TERM_FROM_ATOM_INDEX(FALSE_ATOM_INDEX) #define TRUE_ATOM TERM_FROM_ATOM_INDEX(TRUE_ATOM_INDEX) @@ -317,6 +324,12 @@ extern "C" { #define GLOBAL_ATOM TERM_FROM_ATOM_INDEX(GLOBAL_ATOM_INDEX) +#define TYPE_ATOM TERM_FROM_ATOM_INDEX(TYPE_ATOM_INDEX) +#define NAME_ATOM TERM_FROM_ATOM_INDEX(NAME_ATOM_INDEX) +#define ARITY_ATOM TERM_FROM_ATOM_INDEX(ARITY_ATOM_INDEX) +#define EXTERNAL_ATOM TERM_FROM_ATOM_INDEX(EXTERNAL_ATOM_INDEX) +#define LOCAL_ATOM TERM_FROM_ATOM_INDEX(LOCAL_ATOM_INDEX) + void defaultatoms_init(GlobalContext *glb); void platform_defaultatoms_init(GlobalContext *glb); diff --git a/src/libAtomVM/nifs.c b/src/libAtomVM/nifs.c index a4fa6804f..6baff8cd3 100644 --- a/src/libAtomVM/nifs.c +++ b/src/libAtomVM/nifs.c @@ -145,6 +145,7 @@ static term nif_erts_debug_flat_size(Context *ctx, int argc, term argv[]); static term nif_erlang_process_flag(Context *ctx, int argc, term argv[]); static term nif_erlang_processes(Context *ctx, int argc, term argv[]); static term nif_erlang_process_info(Context *ctx, int argc, term argv[]); +static term nif_erlang_fun_info_2(Context *ctx, int argc, term argv[]); static term nif_erlang_put_2(Context *ctx, int argc, term argv[]); static term nif_erlang_system_info(Context *ctx, int argc, term argv[]); static term nif_erlang_system_flag(Context *ctx, int argc, term argv[]); @@ -359,6 +360,12 @@ static const struct Nif float_to_list_nif = .nif_ptr = nif_erlang_float_to_list }; +static const struct Nif fun_info_nif = +{ + .base.type = NIFFunctionType, + .nif_ptr = nif_erlang_fun_info_2 +}; + static const struct Nif is_process_alive_nif = { .base.type = NIFFunctionType, @@ -3651,6 +3658,54 @@ static term nif_erlang_make_fun_3(Context *ctx, int argc, term argv[]) return term_make_function_reference(module_term, function_term, arity_term, &ctx->heap); } +static term nif_erlang_fun_info_2(Context *ctx, int argc, term argv[]) +{ + UNUSED(argc); + term fun = argv[0]; + term key = argv[1]; + + VALIDATE_VALUE(fun, term_is_fun); + VALIDATE_VALUE(key, term_is_atom); + + term value; + switch (key) { + case MODULE_ATOM: { + term module_name; + term_get_function_mfa(fun, ctx, &module_name, NULL, NULL); + value = module_name; + break; + } + case NAME_ATOM: { + term function_name; + term_get_function_mfa(fun, ctx, NULL, &function_name, NULL); + value = function_name; + break; + } + + case ARITY_ATOM: { + term arity; + term_get_function_mfa(fun, ctx, NULL, NULL, &arity); + value = arity; + break; + } + + case TYPE_ATOM: + value = term_is_external_fun(fun) ? EXTERNAL_ATOM : LOCAL_ATOM; + break; + + default: + RAISE_ERROR(BADARG_ATOM); + } + + if (UNLIKELY(memory_ensure_free_with_roots(ctx, TUPLE_SIZE(2), 1, &value, MEMORY_CAN_SHRINK) != MEMORY_GC_OK)) { + RAISE_ERROR(OUT_OF_MEMORY_ATOM); + } + term fun_info_tuple = term_alloc_tuple(2, &ctx->heap); + term_put_tuple_element(fun_info_tuple, 0, key); + term_put_tuple_element(fun_info_tuple, 1, value); + return fun_info_tuple; +} + static term nif_erlang_put_2(Context *ctx, int argc, term argv[]) { UNUSED(argc); diff --git a/src/libAtomVM/nifs.gperf b/src/libAtomVM/nifs.gperf index 120e7e892..d380e3a4f 100644 --- a/src/libAtomVM/nifs.gperf +++ b/src/libAtomVM/nifs.gperf @@ -63,6 +63,7 @@ erlang:float_to_binary/1, &float_to_binary_nif erlang:float_to_binary/2, &float_to_binary_nif erlang:float_to_list/1, &float_to_list_nif erlang:float_to_list/2, &float_to_list_nif +erlang:fun_info/2, &fun_info_nif erlang:insert_element/3, &insert_element_nif erlang:list_to_atom/1, &list_to_atom_nif erlang:list_to_existing_atom/1, &list_to_existing_atom_nif diff --git a/src/libAtomVM/term.c b/src/libAtomVM/term.c index 5a958884b..5bb0f1f41 100644 --- a/src/libAtomVM/term.c +++ b/src/libAtomVM/term.c @@ -680,6 +680,49 @@ TermCompareResult term_compare(term t, term other, TermCompareOpts opts, GlobalC return result; } +void term_get_function_mfa(term fun, Context *ctx, term *m, term *f, term *a) +{ + TERM_DEBUG_ASSERT(term_is_fun(fun)); + + const term *boxed_value = term_to_const_term_ptr(fun); + if (term_is_external_fun(fun)) { + if (m != NULL) { + *m = boxed_value[1]; + } + if (f != NULL) { + *f = boxed_value[2]; + } + if (a != NULL) { + *a = boxed_value[3]; + } + return; + } + + Module *module = (Module *) boxed_value[1]; + if (m != NULL) { + *m = module_get_name(module); + } + if (f != NULL) { + uint32_t fun_index = term_to_int32(boxed_value[2]); + + uint32_t label, arity, n_freeze; + module_get_fun(module, fun_index, &label, &arity, &n_freeze); + + AtomString fun_name = NULL; + bool has_local_name = module_get_function_from_label(module, label, &fun_name, (int *) &arity, ctx->global); + + *f = has_local_name ? globalcontext_make_atom(ctx->global, fun_name) : term_nil(); + } + if (a != NULL) { + uint32_t fun_index = term_to_int32(boxed_value[2]); + + uint32_t label, arity_val, n_freeze; + module_get_fun(module, fun_index, &label, &arity_val, &n_freeze); + + *a = term_make_maybe_boxed_int64(arity_val, &ctx->heap); + } +} + term term_alloc_refc_binary(size_t size, bool is_const, Heap *heap, GlobalContext *glb) { term *boxed_value = memory_heap_alloc(heap, TERM_BOXED_REFC_BINARY_SIZE); diff --git a/src/libAtomVM/term.h b/src/libAtomVM/term.h index 67be1cceb..cbdaff81a 100644 --- a/src/libAtomVM/term.h +++ b/src/libAtomVM/term.h @@ -1523,6 +1523,19 @@ static inline bool term_is_string(term t) return term_is_nil(t); } +/** + * @brief Gets function module name, name and arity. + * + * @details Allows to retrieve partial information by passing NULL pointers. + * @param fun function term. + * @param ctx the \c Context. + * @param m module name as an atom. + * @param f function name as an atom. + * @param a function arity as an integer. + * + */ +void term_get_function_mfa(term fun, Context *ctx, term *m, term *f, term *a); + static inline term term_make_function_reference(term m, term f, term a, Heap *heap) { term *boxed_func = memory_heap_alloc(heap, FUNCTION_REFERENCE_SIZE); diff --git a/tests/erlang_tests/CMakeLists.txt b/tests/erlang_tests/CMakeLists.txt index 1026a2397..18309a16b 100644 --- a/tests/erlang_tests/CMakeLists.txt +++ b/tests/erlang_tests/CMakeLists.txt @@ -169,6 +169,7 @@ compile_erlang(prime_smp) compile_erlang(test_try_case_end) compile_erlang(test_exception_classes) compile_erlang(test_recursion_and_try_catch) +compile_erlang(test_fun_info) compile_erlang(test_func_info) compile_erlang(test_func_info2) compile_erlang(test_func_info3) @@ -642,6 +643,7 @@ add_custom_target(erlang_test_modules DEPENDS test_try_case_end.beam test_exception_classes.beam test_recursion_and_try_catch.beam + test_fun_info.beam test_func_info.beam test_func_info2.beam test_func_info3.beam diff --git a/tests/erlang_tests/test_fun_info.erl b/tests/erlang_tests/test_fun_info.erl new file mode 100644 index 000000000..9271b502c --- /dev/null +++ b/tests/erlang_tests/test_fun_info.erl @@ -0,0 +1,93 @@ +% +% This file is part of AtomVM. +% +% Copyright 2024 Jakub Gonet +% +% 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_fun_info). +-export([start/0, get_fun/1]). + +-define(SUCCESS, (0)). +-define(ERROR, (1)). + +start() -> + try test_funs() of + ok -> ?SUCCESS + catch + _:E:S -> + erlang:display({E, S}), + ?ERROR + end. + +f(_X, _Y, _Z) -> ok. + +get_fun(local) -> fun(B) -> not B end; +get_fun(local_ref) -> fun f/3; +get_fun(external_ref) -> fun erlang:apply/2; +get_fun(not_existing_ref) -> fun erlang:undef/8. + +test_funs() -> + LocalFun = ?MODULE:get_fun(local), + LocalFunRef = ?MODULE:get_fun(local_ref), + ExternalFunRef = ?MODULE:get_fun(external_ref), + NotExistingFunRef = ?MODULE:get_fun(not_existing_ref), + + {module, test_fun_info} = erlang:fun_info(LocalFun, module), + {name, LocalFunName} = erlang:fun_info(LocalFun, name), + % e.g. -get_fun/1-fun-1- + true = atom_contains(LocalFunName, "get_fun"), + {arity, 1} = erlang:fun_info(LocalFun, arity), + {type, local} = erlang:fun_info(LocalFun, type), + + {module, test_fun_info} = erlang:fun_info(LocalFunRef, module), + {name, LocalFunRefName} = erlang:fun_info(LocalFunRef, name), + % across Erlang versions, this representation changed frequently + Format1 = atom_contains(LocalFunRefName, "get_fun"), + Format2 = atom_contains(LocalFunRefName, "f/3"), + Format3 = LocalFunRefName == f, + true = Format1 or Format2 or Format3, + {arity, 3} = erlang:fun_info(LocalFunRef, arity), + {type, local} = erlang:fun_info(LocalFunRef, type), + + {module, erlang} = erlang:fun_info(ExternalFunRef, module), + {name, apply} = erlang:fun_info(ExternalFunRef, name), + {arity, 2} = erlang:fun_info(ExternalFunRef, arity), + {type, external} = erlang:fun_info(ExternalFunRef, type), + + {module, erlang} = erlang:fun_info(NotExistingFunRef, module), + {name, undef} = erlang:fun_info(NotExistingFunRef, name), + {arity, 8} = erlang:fun_info(NotExistingFunRef, arity), + {type, external} = erlang:fun_info(NotExistingFunRef, type), + + ok. + +atom_contains(Atom, Pattern) when is_atom(Atom) -> + atom_contains(atom_to_list(Atom), Pattern); +atom_contains([_C | Rest] = String, Pattern) -> + case prefix_match(String, Pattern) of + true -> true; + false -> atom_contains(Rest, Pattern) + end; +atom_contains([], _Pattern) -> + false. + +prefix_match(_StringTail, []) -> + true; +prefix_match([Char | StringTail], [Char | PatternTail]) -> + prefix_match(StringTail, PatternTail); +prefix_match(_String, _Pattern) -> + false. diff --git a/tests/test.c b/tests/test.c index 859c66b61..3b1360abb 100644 --- a/tests/test.c +++ b/tests/test.c @@ -212,6 +212,7 @@ struct Test tests[] = { TEST_CASE_EXPECTED(test_try_case_end, 256), TEST_CASE(test_exception_classes), TEST_CASE_EXPECTED(test_recursion_and_try_catch, 3628800), + TEST_CASE(test_fun_info), TEST_CASE_EXPECTED(test_func_info, 89), TEST_CASE_EXPECTED(test_func_info2, 1), TEST_CASE_EXPECTED(test_func_info3, 120),