Add fun_info/2

Signed-off-by: Jakub Gonet <[email protected]>

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

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();
     }

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);

src/libAtomVM/nifs.c

@@ -143,6 +143,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[]);
@@ -350,6 +351,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,
@@ -3452,6 +3459,90 @@ 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];
+    VALIDATE_VALUE(fun, term_is_fun);
+    term key = argv[1];
+    VALIDATE_VALUE(key, term_is_atom);
+
+    term value;
+    switch (key) {
+        case MODULE_ATOM: {
+            const term *boxed_value = term_to_const_term_ptr(fun);
+            if (term_is_external_fun(fun)) {
+                term module_atom = boxed_value[1];
+
+                value = module_atom;
+            } else {
+                Module *module = (Module *) boxed_value[1];
+
+                value = module_get_name(module);
+            }
+            break;
+        }
+        case NAME_ATOM: {
+            if (term_is_external_fun(fun)) {
+                const term *boxed_value = term_to_const_term_ptr(fun);
+                term name_atom = boxed_value[2];
+
+                value = name_atom;
+            } else {
+                const term *boxed_value = term_to_const_term_ptr(fun);
+                Module *fun_module = (Module *) boxed_value[1];
+                uint32_t fun_index = term_to_int32(boxed_value[2]);
+
+                uint32_t label, arity, n_freeze;
+                module_get_fun(fun_module, fun_index, &label, &arity, &n_freeze);
+
+                AtomString fun_name = NULL;
+                bool has_local_name = module_get_function_from_label(fun_module, label, &fun_name, (int *) &arity, (GlobalContext *) ctx->global);
+
+                if (has_local_name) {
+                    value = globalcontext_make_atom(ctx->global, fun_name);
+                } else {
+                    value = term_nil();
+                }
+            }
+            break;
+        }
+
+        case ARITY_ATOM:
+            if (term_is_external_fun(fun)) {
+                const term *boxed_value = term_to_const_term_ptr(fun);
+                term arity = boxed_value[3];
+
+                value = make_maybe_boxed_int64(ctx, term_to_int32(arity));
+            } else {
+                const term *boxed_value = term_to_const_term_ptr(fun);
+                Module *module = (Module *) boxed_value[1];
+                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);
+
+                value = make_maybe_boxed_int64(ctx, arity);
+            }
+            break;
+
+        case TYPE_ATOM:
+            value = term_is_external_fun(fun) ? EXTERNAL_ATOM : LOCAL_ATOM;
+            break;
+
+        default:
+            AVM_ABORT();
+    }
+
+    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);

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

src/libAtomVM/term.h

@@ -1503,6 +1503,16 @@ int term_fprint(FILE *fd, term t, const GlobalContext *global);
  */
 int term_snprint(char *buf, size_t size, term t, const GlobalContext *global);
 
+/**
+ * @brief Writes function name (without module and arity for external functions)
+ * as string to a buffer. Caller owns the buffer and must free it when done.
+ * @param fun the function term that will be converted to a string.
+ * @param global the \c GlobalContext.
+ * @param buf pointer to the buffer where the function name will be written.
+ * @returns the number of written characters.
+ */
+int term_local_function_name(term fun, const GlobalContext *global, char **buf);
+
 /**
  * @brief Checks if a term is a string (i.e., a list of characters)
  *

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)
@@ -639,6 +640,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

tests/erlang_tests/test_fun_info.erl

@@ -0,0 +1,88 @@
+%
+% This file is part of AtomVM.
+%
+% Copyright 2024 Jakub Gonet <[email protected]>
+%
+% 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]).
+
+-define(SUCCESS, (0)).
+-define(ERROR, (1)).
+
+start() ->
+    try test_funs() of
+        ok -> ?SUCCESS
+    catch
+        _:E ->
+            erlang:display(E),
+            ?ERROR
+    end.
+
+f(_X, _Y, _Z) -> ok.
+
+test_funs() ->
+    LocalFun = fun(B) -> not B end,
+    LocalFunRef = fun f/3,
+    ExternalFunRef = fun erlang:apply/2,
+    NotExistingFunRef = fun erlang:undef/8,
+
+    {module, test_fun_info} = erlang:fun_info(LocalFun, module),
+    {name, LocalFunName} = erlang:fun_info(LocalFun, name),
+    % e.g. -test_funs/0-fun-1-
+    true = atom_contains(LocalFunName, "test_funs"),
+    {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, "test_funs"),
+    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.

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),