[m-rev.] for review: Speed up retrieval of foreign imports.

[Peter Wang]

For a do-nothing build of Prince with intermodule optimisation enabled,
mmc --make spends a large fraction of its time computing foreign imports,
or rather looking up the cached results of such. (There are 650 modules,
and the results for each module are looked up tens to hundreds of
thousands of times each.)

This change replaces the representation of cached_foreign_imports from
tree234 to one based on version_array. It reduces the average run time
for a do-nothing build of Prince on my machine from 7.850 s to 6.505 s,
for a speedup of ~17%.

compiler/va_map.m:
    Add a module originally written for Prince. I have permission to
    include it in the Mercury compiler and assign copyright to the
    Mercury team.

compiler/libs.m:
    Include the new module in the libs package.

compiler/make.deps_set.m:
    Implement a typeclass needed to use module_index as a va_map key.

compiler/make.dependencies.m:
    Implement a typeclass needed to use maybe(T) as a va_map_value.

    Use va_map to represent cached_foreign_imports instead of map.
---
 compiler/libs.m              |   1 +
 compiler/make.dependencies.m |  20 ++-
 compiler/make.deps_set.m     |  17 ++-
 compiler/va_map.m            | 271 +++++++++++++++++++++++++++++++++++
 4 files changed, 300 insertions(+), 9 deletions(-)
 create mode 100644 compiler/va_map.m

diff --git a/compiler/libs.m b/compiler/libs.m
index 4a56e0df6..cbc3fa105 100644
--- a/compiler/libs.m
+++ b/compiler/libs.m
@@ -42,6 +42,7 @@
 :- include_module md5.
 :- include_module pickle.
 :- include_module uint_emu.
+:- include_module va_map.
 
 % OS interfaces not provided by the standard library.
 :- include_module process_util.
diff --git a/compiler/make.dependencies.m b/compiler/make.dependencies.m
index 52402bacb..cd8aa7c7f 100644
--- a/compiler/make.dependencies.m
+++ b/compiler/make.dependencies.m
@@ -2,6 +2,7 @@
 % vim: ft=mercury ts=4 sw=4 et
 %---------------------------------------------------------------------------%
 % Copyright (C) 2002-2011 The University of Melbourne.
+% Copyright (C) 2013-2017, 2019-2022 The Mercury team.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %---------------------------------------------------------------------------%
@@ -164,6 +165,7 @@
 :- import_module backend_libs.
 :- import_module backend_libs.compile_target_code.
 :- import_module libs.options.
+:- import_module libs.va_map.
 :- import_module make.module_dep_file.
 :- import_module make.util.
 :- import_module parse_tree.
@@ -730,14 +732,17 @@ find_module_foreign_imports_2(Languages, Globals, ModuleIndex, Succeeded,
         ForeignModules, !Info, !IO) :-
     % Languages should be constant for the duration of the process.
     CachedForeignImports0 = !.Info ^ mki_cached_foreign_imports,
-    ( if map.search(CachedForeignImports0, ModuleIndex, Result0) then
+    va_map.lookup(CachedForeignImports0, ModuleIndex, MaybeResult0),
+    (
+        MaybeResult0 = yes(Result0),
         Result0 = deps_result(Succeeded, ForeignModules)
-    else
+    ;
+        MaybeResult0 = no,
         find_module_foreign_imports_3(Languages, Globals, ModuleIndex,
             Succeeded, ForeignModules, !Info, !IO),
         Result = deps_result(Succeeded, ForeignModules),
         CachedForeignImports1 = !.Info ^ mki_cached_foreign_imports,
-        map.det_insert(ModuleIndex, Result,
+        va_map.set(ModuleIndex, yes(Result),
             CachedForeignImports1, CachedForeignImports),
         !Info ^ mki_cached_foreign_imports := CachedForeignImports
     ).
@@ -1375,9 +1380,14 @@ make_write_dependency_file_and_timestamp_list([Head | Tail], !IO) :-
 
 init_cached_direct_imports = map.init.
 
-:- type cached_foreign_imports == map(module_index, module_deps_result).
+:- type cached_foreign_imports ==
+    va_map(module_index, maybe(module_deps_result)).
 
-init_cached_foreign_imports = map.init.
+:- instance va_map_value(maybe(T)) where [
+    default_value = no
+].
+
+init_cached_foreign_imports = va_map.init.
 
 :- type transitive_dependencies_root
     --->    transitive_dependencies_root(
diff --git a/compiler/make.deps_set.m b/compiler/make.deps_set.m
index 0000b10fd..cc890d51f 100644
--- a/compiler/make.deps_set.m
+++ b/compiler/make.deps_set.m
@@ -2,6 +2,7 @@
 % vim: ft=mercury ts=4 sw=4 et
 %---------------------------------------------------------------------------%
 % Copyright (C) 2002-2011 The University of Melbourne.
+% Copyright (C) 2020-2022 The Mercury team.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %---------------------------------------------------------------------------%
@@ -22,6 +23,8 @@
 :- module make.deps_set.
 :- interface.
 
+:- import_module libs.
+:- import_module libs.va_map.
 :- import_module make.dependencies.
 :- import_module make.make_info.
 :- import_module mdbcomp.
@@ -41,6 +44,7 @@
 
 :- type module_index.
 :- instance enum(module_index).
+:- instance va_map_key(module_index).
 
 :- type dependency_file_index.
 :- instance enum(dependency_file_index).
@@ -91,13 +95,13 @@
 
 :- implementation.
 
-:- import_module libs.
 :- import_module parse_tree.
 
 :- import_module int.
 :- import_module maybe.
 :- import_module version_array.
 :- import_module version_hash_table.
+:- import_module uint.
 
 %---------------------------------------------------------------------------%
 %
@@ -107,14 +111,19 @@
 :- type module_index
     --->    module_index(int).
 
-:- type dependency_file_index
-    --->    dependency_file_index(int).
-
 :- instance enum(module_index) where [
     to_int(module_index(I)) = I,
     from_int(I) = module_index(I)
 ].
 
+:- instance va_map_key(module_index) where [
+    ( from_key(module_index(I)) = uint.cast_from_int(I) ),
+    ( to_key(U) = module_index(uint.cast_to_int(U)) )
+].
+
+:- type dependency_file_index
+    --->    dependency_file_index(int).
+
 :- instance enum(dependency_file_index) where [
     to_int(dependency_file_index(I)) = I,
     from_int(I) = dependency_file_index(I)
diff --git a/compiler/va_map.m b/compiler/va_map.m
new file mode 100644
index 000000000..49df0a144
--- /dev/null
+++ b/compiler/va_map.m
@@ -0,0 +1,271 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2022 YesLogic Pty. Ltd.
+% Copyright (C) 2022 The Mercury team.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: va_map.m.
+% Main author: wangp.
+%
+% This module defines a data structure that is like an automatically growing
+% array with a map-like interface. Keys are restricted to values that can be
+% converted to and from a uint.
+%
+% Like an array, it provides O(1) indexing and update when accessing the latest
+% version of the data structure.
+%
+% Unlike an array, the data structure automatically accomodates keys outside of
+% the existing bounds. This is more like a map.
+%
+% Unlike a map, keys that were not explicitly set are implicitly associated
+% with a default value. This is more like an array.
+%
+% Internally, the key space is divided into "pages". Each page is represented
+% by a version array, and is allocated on demand. There is no extra bitmap or
+% boxing of values, etc. to differentiate between implicitly or explicitly set
+% array slots.
+
+%---------------------------------------------------------------------------%
+
+:- module libs.va_map.
+:- interface.
+
+:- type va_map(K, V).
+
+    % The keys of a va_map must be convertible to/from a uint.
+    %
+:- typeclass va_map_key(K) where [
+    func from_key(K) = uint,
+    func to_key(uint) = K
+].
+
+    % The value type of a va_map must have a default value.
+    %
+:- typeclass va_map_value(V) where [
+    func default_value = V
+].
+
+    % Create a new va_map.
+    % All keys are implicitly associated with the default value.
+    %
+    % NOTE: the implementation uses "thread-unsafe" version_arrays. It is NOT
+    % safe to access or update copies of the same va_map simultaneously.
+    %
+:- func init = va_map(K, V).
+
+    % Return the value associated with the given key in the map.
+    %
+:- pred lookup(va_map(K, V)::in, K::in, V::out) is det
+    <= (va_map_key(K), va_map_value(V)).
+
+    % Insert or update the key with the given value.
+    %
+:- pred set(K::in, V::in, va_map(K, V)::in, va_map(K, V)::out) is det
+    <= (va_map_key(K), va_map_value(V)).
+
+    % Perform an inorder traversal of the va_map, applying
+    % an accumulator predicate for each key-value pair.
+    %
+:- pred foldl(pred(K, V, T, T), va_map(K, V), T, T) <= va_map_key(K).
+:- mode foldl(in(pred(in, in, di, uo) is det), in, di, uo) is det.
+:- mode foldl(in(pred(in, in, in, out) is det), in, in, out) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module uint.
+:- import_module version_array.
+
+:- type va_map(K, V)
+    --->    va_map(va_map_pages(V)).
+
+:- type va_map_pages(V) == version_array(va_map_page_or_null(V)).
+
+:- type va_map_page(V) == version_array(V).
+
+:- type va_map_page_or_null(V).
+:- pragma foreign_type("C", va_map_page_or_null(V), "void *",
+    [can_pass_as_mercury_type]).
+
+%---------------------------------------------------------------------------%
+
+:- func null_page = va_map_page_or_null(V).
+
+:- pragma foreign_proc("C",
+    null_page = (PageOrNull::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    PageOrNull = NULL;
+").
+
+:- func to_page_or_null(va_map_page(V)) = va_map_page_or_null(V).
+
+:- pragma foreign_proc("C",
+    to_page_or_null(Page::in) = (PageOrNull::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    PageOrNull = Page;
+").
+
+:- pred non_null_page(va_map_page_or_null(V)::in, va_map_page(V)::out)
+    is semidet.
+
+:- pragma foreign_proc("C",
+    non_null_page(PageOrNull::in, Page::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Page = PageOrNull;
+    SUCCESS_INDICATOR = (Page != NULL);
+").
+
+%---------------------------------------------------------------------------%
+
+:- func page_size = int.
+
+page_size = 512.
+    % We divide the key space into pages to avoid one overly large object that
+    % would (probably) be bad for GC. The optimal page size is likely to depend
+    % on multiple factors, but this appears to be a decent choice for our use
+    % of va_map.
+    %
+    % 512 * 4 = 2048 bytes
+    % 512 * 8 = 4096 bytes
+
+:- pred split_key(K::in, int::out, int::out) is det <= va_map_key(K).
+
+split_key(K, PageNum, SlotNum) :-
+    U = from_key(K),
+    % page_size = 512
+    PageNum = uint.cast_to_int(U >> 9),
+    SlotNum = uint.cast_to_int(U /\ 0x1FF_u).
+
+:- pred unsplit_key(int::in, int::in, K::out) is det <= va_map_key(K).
+
+unsplit_key(PageNum, SlotNum, K) :-
+    % page_size = 512
+    U = uint.cast_from_int(PageNum) << 9 \/ uint.cast_from_int(SlotNum),
+    K = to_key(U).
+
+%---------------------------------------------------------------------------%
+
+init = va_map(VA) :-
+    VA = version_array.unsafe_empty.
+
+%---------------------------------------------------------------------------%
+
+lookup(VAMap, K, V) :-
+    VAMap = va_map(Pages),
+    split_key(K, PageNum, Slot),
+    ( if
+        PageNum < size(Pages),
+        version_array.lookup(Pages, PageNum) = PageOrNull,
+        non_null_page(PageOrNull, Page)
+    then
+        version_array.lookup(Page, Slot) = V
+    else
+        V = default_value
+    ).
+
+%---------------------------------------------------------------------------%
+
+set(K, V, VAMap0, VAMap) :-
+    VAMap0 = va_map(Pages0),
+    split_key(K, PageNum, Slot),
+    maybe_grow_pages(PageNum, Pages0, Pages1),
+    version_array.lookup(Pages1, PageNum) = PageOrNull0,
+    ( if non_null_page(PageOrNull0, Page0) then
+        Page1 = Page0
+    else
+        create_page(Page1)
+    ),
+    version_array.set(Slot, V, Page1, Page),
+    version_array.set(PageNum, to_page_or_null(Page), Pages1, Pages),
+    VAMap = va_map(Pages).
+
+:- pred maybe_grow_pages(int::in, va_map_pages(V)::in, va_map_pages(V)::out)
+    is det.
+
+maybe_grow_pages(PageNum, !Pages) :-
+    Size0 = size(!.Pages),
+    ( if PageNum >= Size0 then
+        NewSize = roundup_pages(PageNum + 1),
+        version_array.resize(NewSize, null_page, !Pages)
+    else
+        true
+    ).
+
+:- func roundup_pages(int) = int.
+
+roundup_pages(N) =
+    % Round up to next multiple of 4 (arbitrarily).
+    (N + 3) // 4 * 4.
+
+:- pred create_page(va_map_page(V)::out) is det <= va_map_value(V).
+
+create_page(Page) :-
+    Page = version_array.unsafe_init(page_size, default_value).
+
+%---------------------------------------------------------------------------%
+
+foldl(Pred, VAMap, !A) :-
+    VAMap = va_map(Pages),
+    foldl_with_index(foldl_page(Pred), Pages, !A).
+
+:- pred foldl_page(pred(K, V, T, T), int, va_map_page_or_null(V), T, T)
+    <= va_map_key(K).
+:- mode foldl_page(in(pred(in, in, di, uo) is det), in, in, di, uo) is det.
+:- mode foldl_page(in(pred(in, in, in, out) is det), in, in, in, out) is det.
+
+foldl_page(Pred, PageNum, PageOrNull, !A) :-
+    ( if non_null_page(PageOrNull, Page) then
+        foldl_with_index(foldl_slot(Pred, PageNum), Page, !A)
+    else
+        true
+    ).
+
+:- pred foldl_slot(pred(K, V, T, T), int, int, V, T, T) <= va_map_key(K).
+:- mode foldl_slot(in(pred(in, in, di, uo) is det), in, in, in, di, uo)
+    is det.
+:- mode foldl_slot(in(pred(in, in, in, out) is det), in, in, in, in, out)
+    is det.
+
+foldl_slot(Pred, PageNum, Slot, V, !A) :-
+    unsplit_key(PageNum, Slot, K),
+    Pred(K, V, !A).
+
+%---------------------------------------------------------------------------%
+
+    % Same as version_array.foldl but provides the index.
+    %
+:- pred foldl_with_index(pred(int, V, T, T), version_array(V), T, T).
+:- mode foldl_with_index(in(pred(in, in, di, uo) is det), in, di, uo) is det.
+:- mode foldl_with_index(in(pred(in, in, in, out) is det), in, in, out) is det.
+
+foldl_with_index(Pred, VA, !A) :-
+    foldl_with_index_loop(Pred, VA, 0, size(VA), !A).
+
+:- pred foldl_with_index_loop(pred(int, V, T, T), version_array(V),
+    int, int, T, T).
+:- mode foldl_with_index_loop(in(pred(in, in, di, uo) is det), in,
+    in, in, di, uo) is det.
+:- mode foldl_with_index_loop(in(pred(in, in, in, out) is det), in,
+    in, in, in, out) is det.
+
+foldl_with_index_loop(Pred, VA, Index, Size, !A) :-
+    ( if Index < Size then
+        version_array.lookup(VA, Index) = Value,
+        Pred(Index, Value, !A),
+        foldl_with_index_loop(Pred, VA, Index + 1, Size, !A)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+:- end_module libs.va_map.
+%---------------------------------------------------------------------------%
-- 
2.38.0