Merge pull request #732 from pguyot/w31/implement-module-info

Implement Module:module_info/0,1

Actually implement erlang:get_module_info/1,2 which are called by glue inserted
by compiler.
Fix #701

These changes are made under both the "Apache 2.0" and the "GNU Lesser General
Public License 2.1 or later" license terms (dual license).

SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later

libs/estdlib/src/erlang.erl

@@ -79,7 +79,9 @@
     open_port/2,
     system_time/1,
     group_leader/0,
-    process_flag/2
+    process_flag/2,
+    get_module_info/1,
+    get_module_info/2
 ]).
 
 -export_type([
@@ -844,3 +846,31 @@ group_leader() ->
 -spec process_flag(Flag :: trap_exit, Value :: boolean()) -> pid().
 process_flag(_Flag, _Value) ->
     throw(nif_error).
+
+%%-----------------------------------------------------------------------------
+%% @param   Module  module to get info for
+%% @returns A list of module info tuples
+%% @doc     Get info for a given module.
+%% This function is not meant to be called directly but through
+%% `Module:module_info/0' exported function.
+%%
+%% @end
+%%-----------------------------------------------------------------------------
+-spec get_module_info(Module :: atom()) -> [{atom(), any()}].
+get_module_info(_Module) ->
+    throw(nif_error).
+
+%%-----------------------------------------------------------------------------
+%% @param   Module  module to get info for
+%% @param   InfoKey info to get
+%% @returns A term representing info for given module
+%% @doc     Get specific info for a given module.
+%% This function is not meant to be called directly but through
+%% `Module:module_info/1' exported function.
+%% Supported info keys are `module', `exports', `compile' and `attributes'.
+%%
+%% @end
+%%-----------------------------------------------------------------------------
+-spec get_module_info(Module :: atom(), InfoKey :: atom()) -> any().
+get_module_info(_Module, _InfoKey) ->
+    throw(nif_error).

src/libAtomVM/defaultatoms.c

@@ -139,6 +139,10 @@ static const char *const select_atom = "\x6" "select";
 static const char *const ready_input_atom = "\xB" "ready_input";
 static const char *const ready_output_atom = "\xC" "ready_output";
 
+static const char *const attributes_atom = "\xA" "attributes";
+static const char *const compile_atom = "\x7" "compile";
+static const char *const exports_atom = "\x7" "exports";
+
 void defaultatoms_init(GlobalContext *glb)
 {
     int ok = 1;
@@ -262,6 +266,10 @@ void defaultatoms_init(GlobalContext *glb)
     ok &= globalcontext_insert_atom(glb, ready_input_atom) == READY_INPUT_ATOM_INDEX;
     ok &= globalcontext_insert_atom(glb, ready_output_atom) == READY_OUTPUT_ATOM_INDEX;
 
+    ok &= globalcontext_insert_atom(glb, attributes_atom) == ATTRIBUTES_ATOM_INDEX;
+    ok &= globalcontext_insert_atom(glb, compile_atom) == COMPILE_ATOM_INDEX;
+    ok &= globalcontext_insert_atom(glb, exports_atom) == EXPORTS_ATOM_INDEX;
+
     if (!ok) {
         AVM_ABORT();
     }

src/libAtomVM/defaultatoms.h

@@ -148,7 +148,11 @@ extern "C" {
 #define READY_INPUT_ATOM_INDEX 94
 #define READY_OUTPUT_ATOM_INDEX 95
 
-#define PLATFORM_ATOMS_BASE_INDEX 96
+#define ATTRIBUTES_ATOM_INDEX 96
+#define COMPILE_ATOM_INDEX 97
+#define EXPORTS_ATOM_INDEX 98
+
+#define PLATFORM_ATOMS_BASE_INDEX 99
 
 #define FALSE_ATOM TERM_FROM_ATOM_INDEX(FALSE_ATOM_INDEX)
 #define TRUE_ATOM TERM_FROM_ATOM_INDEX(TRUE_ATOM_INDEX)
@@ -271,6 +275,10 @@ extern "C" {
 #define READY_INPUT_ATOM TERM_FROM_ATOM_INDEX(READY_INPUT_ATOM_INDEX)
 #define READY_OUTPUT_ATOM TERM_FROM_ATOM_INDEX(READY_OUTPUT_ATOM_INDEX)
 
+#define ATTRIBUTES_ATOM TERM_FROM_ATOM_INDEX(ATTRIBUTES_ATOM_INDEX)
+#define COMPILE_ATOM TERM_FROM_ATOM_INDEX(COMPILE_ATOM_INDEX)
+#define EXPORTS_ATOM TERM_FROM_ATOM_INDEX(EXPORTS_ATOM_INDEX)
+
 void defaultatoms_init(GlobalContext *glb);
 
 void platform_defaultatoms_init(GlobalContext *glb);

src/libAtomVM/module.c

@@ -24,9 +24,11 @@
 #include "bif.h"
 #include "context.h"
 #include "externalterm.h"
+#include "globalcontext.h"
 #include "iff.h"
 #include "list.h"
 #include "nifs.h"
+#include "term.h"
 #include "utils.h"
 #include "sys.h"
 #include "smp.h"
@@ -192,12 +194,19 @@ bool module_get_function_from_label(Module *this_module, int label, AtomString *
     return true;
 }
 
-uint32_t module_search_exported_function(Module *this_module, AtomString func_name, int func_arity)
+size_t module_get_exported_functions_count(Module *this_module)
 {
     const uint8_t *table_data = (const uint8_t *) this_module->export_table;
-    int functions_count = READ_32_ALIGNED(table_data + 8);
+    size_t functions_count = READ_32_ALIGNED(table_data + 8);
+    return functions_count;
+}
 
-    for (int i = 0; i < functions_count; i++) {
+uint32_t module_search_exported_function(Module *this_module, AtomString func_name, int func_arity)
+{
+    size_t functions_count = module_get_exported_functions_count(this_module);
+
+    const uint8_t *table_data = (const uint8_t *) this_module->export_table;
+    for (unsigned int i = 0; i < functions_count; i++) {
         AtomString function_atom = module_get_atom_string_by_id(this_module, READ_32_ALIGNED(table_data + i * 12 + 12));
         int32_t arity = READ_32_ALIGNED(table_data + i * 12 + 4 + 12);
         if ((func_arity == arity) && atom_are_equals(func_name, function_atom)) {
@@ -209,6 +218,23 @@ uint32_t module_search_exported_function(Module *this_module, AtomString func_na
     return 0;
 }
 
+term module_get_exported_functions(Module *this_module, Heap *heap, GlobalContext *global)
+{
+    size_t functions_count = module_get_exported_functions_count(this_module);
+    term result_list = term_nil();
+
+    const uint8_t *table_data = (const uint8_t *) this_module->export_table;
+    for (unsigned int i = 0; i < functions_count; i++) {
+        AtomString function_atom = module_get_atom_string_by_id(this_module, READ_32_ALIGNED(table_data + i * 12 + 12));
+        int32_t arity = READ_32_ALIGNED(table_data + i * 12 + 4 + 12);
+        term function_tuple = term_alloc_tuple(2, heap);
+        term_put_tuple_element(function_tuple, 0, globalcontext_existing_term_from_atom_string(global, function_atom));
+        term_put_tuple_element(function_tuple, 1, term_from_int(arity));
+        result_list = term_list_prepend(function_tuple, result_list, heap);
+    }
+    return result_list;
+}
+
 static void module_add_label(Module *mod, int index, void *ptr)
 {
     mod->labels[index] = ptr;

src/libAtomVM/module.h

@@ -40,6 +40,7 @@ extern "C" {
 #include "context.h"
 #include "exportedfunction.h"
 #include "globalcontext.h"
+#include "term.h"
 #include "valueshashtable.h"
 
 #ifndef AVM_NO_SMP
@@ -159,6 +160,18 @@ enum ModuleLoadResult
 void module_get_imported_function_module_and_name(const Module *this_module, int index, AtomString *module_atom, AtomString *function_atom);
 #endif
 
+/**
+ * @brief Count exported functions of a given module
+ *
+ * @details Get the number of exported functions.
+ * This function is used to compute the required heap size of the list of
+ * exported functions.
+ *
+ * @param this_module the module to count exported functions of
+ * @return the number of exported functions
+ */
+size_t module_get_exported_functions_count(Module *this_module);
+
 /**
  * @brief Gets exported function index by searching it by function name and arity
  *
@@ -169,6 +182,30 @@ void module_get_imported_function_module_and_name(const Module *this_module, int
  */
 uint32_t module_search_exported_function(Module *this_module, AtomString func_name, int func_arity);
 
+/**
+ * @brief Determine heap size of exported functions list.
+ *
+ * @param this_module the module to count exported functions of
+ * @return the size, in terms, of the exported function list
+ */
+static inline size_t module_get_exported_functions_list_size(Module *this_module)
+{
+    return (TUPLE_SIZE(2) + CONS_SIZE) * module_get_exported_functions_count(this_module);
+}
+
+/**
+ * @brief Get the list of exported functions
+ * @details Create a list of exported functions of the form `{FunctionName, Arity}`
+ * To create this list, the heap must be grown by `module_get_exported_functions_list_size`
+ * terms.
+ *
+ * @param this_module the module to count exported functions of
+ * @param heap heap to allocate tuples
+ * @param global global context to fetch atoms
+ * @return a list of exported functions
+ */
+term module_get_exported_functions(Module *this_module, Heap *heap, GlobalContext *global);
+
 /***
  * @brief Destoys an existing Module
  *

src/libAtomVM/nifs.c

@@ -146,6 +146,7 @@ static term nif_erlang_fun_to_list(Context *ctx, int argc, term argv[]);
 static term nif_erlang_function_exported(Context *ctx, int argc, term argv[]);
 static term nif_erlang_garbage_collect(Context *ctx, int argc, term argv[]);
 static term nif_erlang_group_leader(Context *ctx, int argc, term argv[]);
+static term nif_erlang_get_module_info(Context *ctx, int argc, term argv[]);
 static term nif_erlang_memory(Context *ctx, int argc, term argv[]);
 static term nif_erlang_monitor(Context *ctx, int argc, term argv[]);
 static term nif_erlang_demonitor(Context *ctx, int argc, term argv[]);
@@ -628,6 +629,12 @@ static const struct Nif group_leader_nif =
     .nif_ptr = nif_erlang_group_leader
 };
 
+static const struct Nif get_module_info_nif =
+{
+    .base.type = NIFFunctionType,
+    .nif_ptr = nif_erlang_get_module_info
+};
+
 static const struct Nif raise_nif =
 {
     .base.type = NIFFunctionType,
@@ -3348,6 +3355,66 @@ static term nif_erlang_group_leader(Context *ctx, int argc, term argv[])
     }
 }
 
+static term nif_erlang_get_module_info(Context *ctx, int argc, term argv[])
+{
+    VALIDATE_VALUE(argv[0], term_is_atom);
+    if (argc == 2) {
+        VALIDATE_VALUE(argv[1], term_is_atom);
+    }
+    term module = argv[0];
+    AtomString module_name = globalcontext_atomstring_from_term(ctx->global, module);
+    Module *target_module = globalcontext_get_module(ctx->global, module_name);
+    if (IS_NULL_PTR(target_module)) {
+        RAISE_ERROR(BADARG_ATOM);
+    }
+    if (argc == 2) {
+        term key = argv[1];
+        if (key == MODULE_ATOM) {
+            return argv[0];
+        }
+        if (key == ATTRIBUTES_ATOM || key == COMPILE_ATOM) {
+            return term_nil();
+        }
+        if (key != EXPORTS_ATOM) {
+            RAISE_ERROR(BADARG_ATOM);
+        }
+    }
+    size_t info_size = module_get_exported_functions_list_size(target_module);
+    if (argc == 1) {
+        info_size += TUPLE_SIZE(2) + 3 * (TUPLE_SIZE(2) + CONS_SIZE);
+    }
+    if (UNLIKELY(memory_ensure_free(ctx, info_size) != MEMORY_GC_OK)) {
+        RAISE_ERROR(OUT_OF_MEMORY_ATOM);
+    }
+    term exports = module_get_exported_functions(target_module, &ctx->heap, ctx->global);
+    if (argc == 2) {
+        return exports;
+    }
+    term result = term_nil();
+
+    term compile_tuple = term_alloc_tuple(2, &ctx->heap);
+    term_put_tuple_element(compile_tuple, 0, COMPILE_ATOM);
+    term_put_tuple_element(compile_tuple, 1, term_nil());
+    result = term_list_prepend(compile_tuple, result, &ctx->heap);
+
+    term attributes_tuple = term_alloc_tuple(2, &ctx->heap);
+    term_put_tuple_element(attributes_tuple, 0, ATTRIBUTES_ATOM);
+    term_put_tuple_element(attributes_tuple, 1, term_nil());
+    result = term_list_prepend(attributes_tuple, result, &ctx->heap);
+
+    term exports_tuple = term_alloc_tuple(2, &ctx->heap);
+    term_put_tuple_element(exports_tuple, 0, EXPORTS_ATOM);
+    term_put_tuple_element(exports_tuple, 1, exports);
+    result = term_list_prepend(exports_tuple, result, &ctx->heap);
+
+    term module_tuple = term_alloc_tuple(2, &ctx->heap);
+    term_put_tuple_element(module_tuple, 0, MODULE_ATOM);
+    term_put_tuple_element(module_tuple, 1, module);
+    result = term_list_prepend(module_tuple, result, &ctx->heap);
+
+    return result;
+}
+
 struct RefcBinaryAVMPack
 {
     struct AVMPackData base;

src/libAtomVM/nifs.gperf

@@ -116,6 +116,8 @@ erlang:garbage_collect/0, &garbage_collect_nif
 erlang:garbage_collect/1, &garbage_collect_nif
 erlang:group_leader/0, &group_leader_nif
 erlang:group_leader/2, &group_leader_nif
+erlang:get_module_info/1, &get_module_info_nif
+erlang:get_module_info/2, &get_module_info_nif
 erts_debug:flat_size/1, &flat_size_nif
 atomvm:add_avm_pack_binary/2, &atomvm_add_avm_pack_binary_nif
 atomvm:add_avm_pack_file/2, &atomvm_add_avm_pack_file_nif

tests/erlang_tests/CMakeLists.txt

@@ -474,6 +474,7 @@ compile_erlang(test_add_avm_pack_file)
 compile_erlang(test_close_avm_pack)
 
 compile_erlang(test_min_max_guard)
+compile_erlang(test_module_info)
 
 add_custom_target(erlang_test_modules DEPENDS
     code_load_files
@@ -913,4 +914,5 @@ add_custom_target(erlang_test_modules DEPENDS
     test_close_avm_pack.beam
 
     test_min_max_guard.beam
+    test_module_info.beam
 )

tests/erlang_tests/test_module_info.erl

@@ -0,0 +1,68 @@
+%
+% This file is part of AtomVM.
+%
+% Copyright 2023 Paul Guyot <[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_module_info).
+
+-export([start/0]).
+
+start() ->
+    ok = test_module_info0(),
+    ok = test_module_info1(),
+    0.
+
+test_module_info0() ->
+    ModuleInfo = ?MODULE:module_info(),
+    ?MODULE = proplists_get_value(module, ModuleInfo),
+    CompileList = proplists_get_value(compile, ModuleInfo),
+    true = is_list(CompileList),
+    AttributesList = proplists_get_value(attributes, ModuleInfo),
+    true = is_list(AttributesList),
+    Exports = proplists_get_value(exports, ModuleInfo),
+    true = lists_member({start, 0}, Exports),
+    true = lists_member({module_info, 0}, Exports),
+    true = lists_member({module_info, 1}, Exports),
+    ok.
+
+test_module_info1() ->
+    ?MODULE = ?MODULE:module_info(module),
+    CompileList = ?MODULE:module_info(compile),
+    true = is_list(CompileList),
+    AttributesList = ?MODULE:module_info(attributes),
+    true = is_list(AttributesList),
+    Exports = ?MODULE:module_info(exports),
+    true = lists_member({start, 0}, Exports),
+    true = lists_member({module_info, 0}, Exports),
+    true = lists_member({module_info, 1}, Exports),
+    ok =
+        try
+            ?MODULE:module_info(unknown_module_info),
+            fail
+        catch
+            error:badarg -> ok
+        end,
+    ok.
+
+proplists_get_value(_Key, []) -> undefined;
+proplists_get_value(Key, [{Key, Value} | _Tail]) -> Value;
+proplists_get_value(Key, [_Pair | Tail]) -> proplists_get_value(Key, Tail).
+
+lists_member(_Elem, []) -> false;
+lists_member(Elem, [Elem | _Tail]) -> true;
+lists_member(Elem, [_Other | Tail]) -> lists_member(Elem, Tail).

tests/test.c

@@ -487,6 +487,8 @@ struct Test tests[] = {
     TEST_CASE_ATOMVM_ONLY(test_add_avm_pack_file, 24),
     TEST_CASE_ATOMVM_ONLY(test_close_avm_pack, 0),
 
+    TEST_CASE(test_module_info),
+
     // noisy tests, keep them at the end
     TEST_CASE_EXPECTED(spawn_opt_monitor_normal, 1),
     TEST_CASE_EXPECTED(spawn_opt_link_normal, 1),