Add fun_info/2

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.6] - Unreleased
 

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

@@ -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, &module_name, NULL, NULL, ctx->global);
+            value = module_name;
+            break;
+        }
+        case NAME_ATOM: {
+            term function_name;
+            term_get_function_mfa(fun, NULL, &function_name, NULL, ctx->global);
+            value = function_name;
+            break;
+        }
+
+        case ARITY_ATOM: {
+            term arity;
+            term_get_function_mfa(fun, NULL, NULL, &arity, ctx->global);
+            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), 2, (term[]) { key, 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.c

@@ -680,6 +680,50 @@ TermCompareResult term_compare(term t, term other, TermCompareOpts opts, GlobalC
     return result;
 }
 
+void term_get_function_mfa(term fun, term *m, term *f, term *a, GlobalContext *global)
+{
+    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, global);
+
+        *f = has_local_name ? globalcontext_make_atom(global, fun_name) : term_nil();
+    }
+    if (a != 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);
+        TERM_DEBUG_ASSERT(arity <= 255);
+
+        *a = term_from_int11((int16_t) arity);
+    }
+}
+
 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);

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 m module name as an atom.
+ * @param f function name as an atom.
+ * @param a function arity as an integer.
+ * @param global the \c GlobalContext used for creating function name atoms.
+ *
+ */
+void term_get_function_mfa(term fun, term *m, term *f, term *a, GlobalContext *global);
+
 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);

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)
@@ -643,6 +644,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,93 @@
+%
+% 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, 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.

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