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