File 0287-dialyzer-Parallelize-remote-types-processing-in-reco.patch of Package erlang

From 08340568a0bb891ba04b16ab8ba117c026a3cfec Mon Sep 17 00:00:00 2001
From: Hans Bolinder <hasse@erlang.org>
Date: Mon, 2 Aug 2021 16:13:12 +0200
Subject: [PATCH 7/7] dialyzer: Parallelize remote types processing in records

This has effect if many processes can run i parallel.

The cashe used to be re-used by modules, but now a new cache is
created for each module.
---
 lib/dialyzer/src/dialyzer_coordinator.erl |  28 +++-
 lib/dialyzer/src/dialyzer_utils.erl       | 156 +++++++++++++++-------
 lib/dialyzer/src/dialyzer_worker.erl      |   9 +-
 3 files changed, 133 insertions(+), 60 deletions(-)

diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl
index f8a078364b..01c46b4380 100644
--- a/lib/dialyzer/src/dialyzer_coordinator.erl
+++ b/lib/dialyzer/src/dialyzer_coordinator.erl
@@ -44,16 +44,18 @@
 
 -type scc()     :: [mfa_or_funlbl()].
 -type mode()    :: 'typesig' | 'dataflow' | 'compile' | 'warnings' |
-                   'contract_remote_types'.
+                   'contract_remote_types' | 'record_remote_types'.
 
 -type compile_job()  :: file:filename().
 -type typesig_job()  :: scc().
 -type dataflow_job() :: module().
 -type warnings_job() :: module().
 -type contract_remote_types_job() :: module().
+-type record_remote_types_job() :: module().
 
 -type job() :: compile_job() | typesig_job() | dataflow_job() |
-               warnings_job() | contract_remote_types_job().
+               warnings_job() | contract_remote_types_job() |
+               record_remote_types_job().
 
 -type compile_init_data()  :: dialyzer_analysis_callgraph:compile_init_data().
 -type typesig_init_data()  :: dialyzer_succ_typings:typesig_init_data().
@@ -61,6 +63,8 @@
 -type warnings_init_data() :: dialyzer_succ_typings:warnings_init_data().
 -type contract_remote_types_init_data() ::
                       dialyzer_contracts:contract_remote_types_init_data().
+-type record_remote_types_init_data() ::
+                      dialyzer_utils:record_remote_types_init_data().
 
 -type compile_result()  :: dialyzer_analysis_callgraph:compile_result().
 -type typesig_result()  :: [mfa_or_funlbl()].
@@ -68,19 +72,24 @@
 -type warnings_result() :: [dial_warning()].
 -type contract_remote_types_result() ::
         dialyzer_contracts:contract_remote_types_result().
+-type record_remote_types_result() ::
+        dialyzer_utils:record_remote_types_result().
 
 -type init_data() :: compile_init_data() | typesig_init_data() |
 		     dataflow_init_data() | warnings_init_data() |
-                     contract_remote_types_init_data().
+                     contract_remote_types_init_data() |
+                     record_remote_types_init_data().
 
 -type result() :: compile_result() | typesig_result() |
 		  dataflow_result() | warnings_result() |
-                  contract_remote_types_result().
+                  contract_remote_types_result() |
+                  record_remote_types_result().
 
 -type job_result() :: dialyzer_analysis_callgraph:one_file_mid_error() |
                       dialyzer_analysis_callgraph:one_file_result_ok() |
                       typesig_result() | dataflow_result() |
-                      warnings_result() | contract_remote_types_result().
+                      warnings_result() | contract_remote_types_result() |
+                      record_remote_types_result().
 
 -record(state, {mode           :: mode(),
 		active     = 0 :: integer(),
@@ -107,7 +116,10 @@
 		   timing()) -> warnings_result();
                   ('contract_remote_types', [contract_remote_types_job()],
                    contract_remote_types_init_data(), timing()) ->
-                      contract_remote_types_result().
+                      contract_remote_types_result();
+                  ('record_remote_types', [record_remote_types_job()],
+                   record_remote_types_init_data(), timing()) ->
+                      record_remote_types_result().
 
 parallel_job(Mode, Jobs, InitData, Timing) ->
   State = spawn_jobs(Mode, Jobs, InitData, Timing),
@@ -173,6 +185,8 @@ collect_result(#state{mode = Mode, active = Active, result = Result,
 	    'warnings' ->
 	      NewResult;
             'contract_remote_types' ->
+              NewResult;
+            'record_remote_types' ->
               NewResult
 	  end;
 	N ->
@@ -203,7 +217,7 @@ update_result(Mode, InitData, Job, Data, Result) ->
       dialyzer_succ_typings:lookup_names(Data, InitData) ++ Result;
     'warnings' ->
       Data ++ Result;
-    'contract_remote_types' ->
+    X when X =:= 'contract_remote_types'; X =:= 'record_remote_types' ->
       Data ++ Result
   end.
 
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index e3a3976366..d81799b301 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -47,9 +47,21 @@
          family/1
 	]).
 
+%% For dialyzer_worker.
+-export([process_record_remote_types_module/2]).
+
+-export_type([record_remote_types_init_data/0,
+              record_remote_types_result/0]).
+
 -include("dialyzer.hrl").
 -include("../../compiler/src/core_parse.hrl").
 
+-type ext_types_message() :: {pid(), 'ext_types',
+                              {mfa(), {file:filename(), erl_anno:location()}}}
+                           | {'error', io_lib:chars()}.
+-type record_remote_types_init_data() :: codeserver().
+-type record_remote_types_result() :: [ext_types_message()].
+
 %%-define(DEBUG, true).
 
 -ifdef(DEBUG).
@@ -233,60 +245,104 @@ get_record_fields([], _RecDict, Acc) ->
 
 %% The field types are cached. Used during analysis when handling records.
 process_record_remote_types(CServer) ->
+  case dialyzer_codeserver:all_temp_modules(CServer) of
+    [] ->
+      CServer;
+    Mods ->
+      ExpTypes = dialyzer_codeserver:get_exported_types_table(CServer),
+      process_opaque_types0(Mods, CServer, ExpTypes),
+      %% CodeServer is updated by each worker, but is still valid
+      %% after updates. Workers call
+      %% process_record_remote_types_module/2 below.
+      Return =
+        dialyzer_coordinator:parallel_job(record_remote_types,
+                                          Mods,
+                                          _InitData=CServer,
+                                          _Timing=none),
+      %% We need to pass on messages and thrown errors from erl_types:
+      _ = [self() ! {self(), ext_types, ExtType} ||
+            {_, ext_types, ExtType} <- Return],
+      case [Error || {error, _} = Error <- Return] of
+        [] ->
+          check_record_fields(Mods, CServer, ExpTypes),
+          dialyzer_codeserver:finalize_records(CServer);
+        [Error | _] ->
+          throw(Error)
+      end
+  end.
+
+-spec process_record_remote_types_module(module(),
+                                         dialyzer_codeserver:codeserver()) ->
+                                            [ext_types_message()].
+
+process_record_remote_types_module(Module, CServer) ->
+
   ExpTypes = dialyzer_codeserver:get_exported_types_table(CServer),
-  Mods = dialyzer_codeserver:all_temp_modules(CServer),
-  process_opaque_types0(Mods, CServer, ExpTypes),
   VarTable = erl_types:var_table__new(),
   RecordTable = dialyzer_codeserver:get_temp_records_table(CServer),
-  ModuleFun =
-    fun(Module) ->
-        RecordMap = dialyzer_codeserver:lookup_temp_mod_records(Module, CServer),
-        RecordFun =
-          fun({Key, Value}, C2) ->
-              case Key of
-                {record, Name} ->
-                  {FileLocation, Fields} = Value,
-                  {File, _Location} = FileLocation,
-                  FieldFun =
-                    fun({Arity, Fields0}, C4) ->
-                        MRA = {Module, Name, Arity},
-                        Site = {record, MRA, File},
-                        {Fields1, C7} =
-                          lists:mapfoldl(fun({FieldName, Field, _}, C5) ->
-                                             check_remote(Field, ExpTypes, MRA,
-                                                          File, RecordTable),
-                                             {FieldT, C6} =
-                                               erl_types:t_from_form
-                                                 (Field, ExpTypes, Site,
-                                                  RecordTable, VarTable,
-                                                  C5),
-                                          {{FieldName, Field, FieldT}, C6}
-                                      end, C4, Fields0),
-                        {{Arity, Fields1}, C7}
-                    end,
-                  {FieldsList, C3} =
-                    lists:mapfoldl(FieldFun, C2, orddict:to_list(Fields)),
-                  {{Key, {FileLocation, orddict:from_list(FieldsList)}}, C3};
-                {_TypeOrOpaque, Name, NArgs} ->
-                  %% Make sure warnings about unknown types are output
-                  %% also for types unused by specs.
-                  MTA = {Module, Name, NArgs},
-                  {{_Module, FileLocation, Form, _ArgNames}, _Type} = Value,
-                  {File, _Location} = FileLocation,
-                  check_remote(Form, ExpTypes, MTA, File, RecordTable),
-                  {{Key, Value}, C2}
-              end
-          end,
-        Cache = erl_types:cache__new(),
-        {RecordList, _NewCache} =
-          lists:mapfoldl(RecordFun, Cache, maps:to_list(RecordMap)),
-        dialyzer_codeserver:store_temp_records(Module,
-                                               maps:from_list(RecordList),
-                                               CServer)
+  RecordMap = dialyzer_codeserver:lookup_temp_mod_records(Module, CServer),
+  RecordFun =
+    fun({Key, Value}, C2) ->
+        case Key of
+          {record, Name} ->
+            {FileLocation, Fields} = Value,
+            {File, _Location} = FileLocation,
+            FieldFun =
+              fun({Arity, Fields0}, C4) ->
+                  MRA = {Module, Name, Arity},
+                  Site = {record, MRA, File},
+                  {Fields1, C7} =
+                    lists:mapfoldl(fun({FieldName, Field, _}, C5) ->
+                                       check_remote(Field, ExpTypes, MRA,
+                                                    File, RecordTable),
+                                       {FieldT, C6} =
+                                         erl_types:t_from_form
+                                           (Field, ExpTypes, Site,
+                                            RecordTable, VarTable,
+                                            C5),
+                                       {{FieldName, Field, FieldT}, C6}
+                                   end, C4, Fields0),
+                  {{Arity, Fields1}, C7}
+              end,
+            {FieldsList, C3} =
+              lists:mapfoldl(FieldFun, C2, orddict:to_list(Fields)),
+            {{Key, {FileLocation, orddict:from_list(FieldsList)}}, C3};
+          {_TypeOrOpaque, Name, NArgs} ->
+            %% Make sure warnings about unknown types are output
+            %% also for types unused by specs.
+            MTA = {Module, Name, NArgs},
+            {{_Module, FileLocation, Form, _ArgNames}, _Type} = Value,
+            {File, _Location} = FileLocation,
+            check_remote(Form, ExpTypes, MTA, File, RecordTable),
+            {{Key, Value}, C2}
+        end
     end,
-  lists:foreach(ModuleFun, Mods),
-  check_record_fields(Mods, CServer, ExpTypes),
-  dialyzer_codeserver:finalize_records(CServer).
+  Cache = erl_types:cache__new(),
+  try
+    {RecordList, _NewCache} =
+      lists:mapfoldl(RecordFun, Cache, maps:to_list(RecordMap)),
+    _NewCodeServer =
+      dialyzer_codeserver:store_temp_records(Module,
+                                             maps:from_list(RecordList),
+                                             CServer),
+    rcv_ext_types()
+  catch
+    throw:{error, _}=Error ->
+      [Error] ++ rcv_ext_types()
+  end.
+
+rcv_ext_types() ->
+  Self = self(),
+  Self ! {Self, done},
+  rcv_ext_types(Self, []).
+
+rcv_ext_types(Self, ExtTypes) ->
+  receive
+    {Self, ext_types, _} = ExtType ->
+      rcv_ext_types(Self, [ExtType | ExtTypes]);
+    {Self, done} ->
+      lists:usort(ExtTypes)
+  end.
 
 %% erl_types:t_from_form() substitutes the declaration of opaque types
 %% for the expanded type in some cases. To make sure the initial type,
diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl
index 64de596da7..1cbee44fe0 100644
--- a/lib/dialyzer/src/dialyzer_worker.erl
+++ b/lib/dialyzer/src/dialyzer_worker.erl
@@ -67,7 +67,7 @@ init(#state{job = SCC, mode = Mode, init_data = InitData,
   loop(updating, State#state{depends_on = DependsOn});
 init(#state{mode = Mode} = State) when
     Mode =:= 'compile'; Mode =:= 'warnings';
-    Mode =:= 'contract_remote_types' ->
+    Mode =:= 'contract_remote_types'; Mode =:= 'record_remote_types' ->
   loop(running, State).
 
 loop(updating, #state{mode = Mode} = State) when
@@ -84,7 +84,8 @@ loop(waiting, #state{mode = Mode} = State) when
   ?debug("~w: Wait: ~p\n", [self(), State#state.job]),
   NewState = wait_for_success_typings(State),
   loop(updating, NewState);
-loop(running, #state{mode = 'contract_remote_types'} = State) ->
+loop(running, #state{mode = Mode} = State) when
+    Mode =:= 'contract_remote_types'; Mode =:= 'record_remote_types' ->
   request_activation(State),
   ?debug("~w: Remote types: ~p\n", [self(), State#state.job]),
   Result = do_work(State),
@@ -135,7 +136,9 @@ do_work(#state{mode = Mode, job = Job, init_data = InitData}) ->
     typesig -> dialyzer_succ_typings:find_succ_types_for_scc(Job, InitData);
     dataflow -> dialyzer_succ_typings:refine_one_module(Job, InitData);
     contract_remote_types ->
-      dialyzer_contracts:process_contract_remote_types_module(Job, InitData)
+      dialyzer_contracts:process_contract_remote_types_module(Job, InitData);
+    record_remote_types ->
+      dialyzer_utils:process_record_remote_types_module(Job, InitData)
   end.
 
 report_to_coordinator(Result, #state{job = Job, coordinator = Coordinator}) ->
-- 
2.31.1

openSUSE Build Service is sponsored by