mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-06 16:08:32 +00:00
428 lines
18 KiB
Mathematica
428 lines
18 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2016, 2018-2020, 2022, 2024 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Test the solver by giving it a set of grade problems to solve,
|
|
% both in the absolute space of all possible grades and relative to
|
|
% several possible sets of installed grades, and print the results,
|
|
% together with operation counts.
|
|
%
|
|
% The intention is that
|
|
%
|
|
% - the absence of ERROR messages in the printed results can be checked
|
|
% simply by grepping for ERROR,
|
|
% - the printout can be checked visually for correctness, both in terms of
|
|
% whether successful solutions are correct and whether failures are diagnosed
|
|
% correctly and with useful error messages, and
|
|
% - the operation counts can be used to see the effects of any attempted
|
|
% speedups.
|
|
%
|
|
|
|
:- module test_grades.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module grade_lib.
|
|
:- import_module grade_lib.grade_setup.
|
|
:- import_module grade_lib.grade_solver.
|
|
:- import_module grade_lib.grade_spec.
|
|
:- import_module grade_lib.grade_state.
|
|
:- import_module grade_lib.grade_string.
|
|
:- import_module grade_lib.grade_structure.
|
|
:- import_module grade_lib.grade_vars.
|
|
:- import_module var_value_names.
|
|
|
|
:- import_module cord.
|
|
:- import_module float.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
:- type installed_grade_set
|
|
---> installed_grade_set(
|
|
igs_name :: string,
|
|
igs_grades :: list(installed_grade)
|
|
).
|
|
|
|
:- type solve_count_stats
|
|
---> solve_count_stats(
|
|
scs_total_num_label_steps :: int,
|
|
scs_total_num_passes :: int,
|
|
scs_total_num_req_tests :: int,
|
|
scs_num_tests :: int
|
|
).
|
|
|
|
main(!IO) :-
|
|
SpecsVersion = specs_version_1,
|
|
AutoconfResults = autoconf_results(autoconf_gcc_regs_avail_yes,
|
|
autoconf_gcc_gotos_avail_yes, autoconf_gcc_labels_avail_yes,
|
|
autoconf_low_tag_bits_avail_3, autoconf_size_of_double_eq_ptr,
|
|
autoconf_merc_file_no),
|
|
setup_solver_info(SpecsVersion, AutoconfResults, SolverInfo0),
|
|
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc", AsmFastGc),
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc.stseg", AsmFastGcStseg),
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc.stseg.tr", AsmFastGcStsegTr),
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc.debug.stseg", AsmFastGcDebugStseg),
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc.decldebug.stseg", AsmFastGcDecldebugStseg),
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc.profdeep.stseg", AsmFastGcProfDeepStseg),
|
|
parse_installed_grade(SolverInfo0,
|
|
"asm_fast.gc.profall.stseg", AsmFastGcProfAllStseg),
|
|
parse_installed_grade(SolverInfo0,
|
|
"none.gc.profall.stseg", NoneGcProfAllStseg),
|
|
parse_installed_grade(SolverInfo0,
|
|
"hlc.gc", HlcGc),
|
|
parse_installed_grade(SolverInfo0,
|
|
"hlc.gc.tr", HlcGcTr),
|
|
parse_installed_grade(SolverInfo0,
|
|
"hlc.gc.par", HlcGcPar),
|
|
parse_installed_grade(SolverInfo0,
|
|
"csharp", Csharp),
|
|
parse_installed_grade(SolverInfo0,
|
|
"java", Java),
|
|
|
|
GradesAll = [AsmFastGc, AsmFastGcStseg, AsmFastGcStsegTr,
|
|
AsmFastGcDebugStseg, AsmFastGcDecldebugStseg,
|
|
AsmFastGcProfDeepStseg, AsmFastGcProfAllStseg, NoneGcProfAllStseg,
|
|
HlcGc, HlcGcTr, HlcGcPar, Csharp, Java],
|
|
SetAll = installed_grade_set("grades_all", GradesAll),
|
|
|
|
GradesLLDSAll = [AsmFastGc, AsmFastGcStseg, AsmFastGcStsegTr,
|
|
AsmFastGcDebugStseg, AsmFastGcDecldebugStseg, AsmFastGcProfDeepStseg,
|
|
AsmFastGcProfAllStseg, NoneGcProfAllStseg],
|
|
SetLLDSAll = installed_grade_set("grades_llds_all", GradesLLDSAll),
|
|
|
|
GradesLLDSDebug = [AsmFastGc, AsmFastGcStseg, AsmFastGcStsegTr,
|
|
AsmFastGcDebugStseg, AsmFastGcDecldebugStseg, AsmFastGcProfDeepStseg],
|
|
SetLLDSDebug = installed_grade_set("grades_llds_debug", GradesLLDSDebug),
|
|
|
|
GradesLLDSProf = [AsmFastGc, AsmFastGcStseg, AsmFastGcStsegTr,
|
|
AsmFastGcProfAllStseg, NoneGcProfAllStseg],
|
|
SetLLDSProf = installed_grade_set("grades_llds_prof", GradesLLDSProf),
|
|
|
|
GradesEMLDS = [HlcGc, HlcGcTr, HlcGcPar, Csharp, Java],
|
|
SetEMLDS = installed_grade_set("grades_emlds", GradesEMLDS),
|
|
|
|
GradesTrOnlyLLDS = [AsmFastGc, AsmFastGcStseg, HlcGc, AsmFastGcStsegTr],
|
|
SetTrOnlyLLDS = installed_grade_set("grades_tr_llds", GradesTrOnlyLLDS),
|
|
|
|
GradesTrOnlyMLDS = [AsmFastGc, AsmFastGcStseg, HlcGc, HlcGcTr],
|
|
SetTrOnlyMLDS = installed_grade_set("grades_tr_mlds", GradesTrOnlyMLDS),
|
|
|
|
InstalledSets = [SetAll, SetLLDSAll, SetLLDSDebug, SetLLDSProf,
|
|
SetEMLDS, SetTrOnlyLLDS, SetTrOnlyMLDS],
|
|
|
|
TestSetSpecs = [broad_test_set_spec, llds_test_set_spec],
|
|
AbsSolveCountStats0 = solve_count_stats(0, 0, 0, 0),
|
|
RelSolveCountStats0 = solve_count_stats(0, 0, 0, 0),
|
|
io.output_stream(OutStream, !IO),
|
|
run_test_sets(OutStream, SolverInfo0, InstalledSets, TestSetSpecs,
|
|
AbsSolveCountStats0, AbsSolveCountStats,
|
|
RelSolveCountStats0, RelSolveCountStats, !IO),
|
|
print_solve_count_stats(OutStream, "\nAbsolute solve counts:\n",
|
|
AbsSolveCountStats, !IO),
|
|
print_solve_count_stats(OutStream, "\nRelative solve counts:\n",
|
|
RelSolveCountStats, !IO).
|
|
|
|
:- pred parse_installed_grade(solver_info::in, string::in,
|
|
installed_grade::out) is det.
|
|
|
|
parse_installed_grade(SolverInfo0, GradeStr, InstalledGrade) :-
|
|
MaybeSpecSuccMap = grade_string_to_succ_soln(GradeStr),
|
|
(
|
|
MaybeSpecSuccMap = ok(SpecSuccMap)
|
|
;
|
|
MaybeSpecSuccMap = error(HeadErrorMsg, TailErrorMsgs),
|
|
string.append_list([HeadErrorMsg | TailErrorMsgs], CombinedErrorMsg),
|
|
unexpected($pred, CombinedErrorMsg)
|
|
),
|
|
SolverVarMap0 = SolverInfo0 ^ si_solver_var_map,
|
|
map.foldl(assign_var_in_map(npw_config), SpecSuccMap,
|
|
SolverVarMap0, SolverVarMap),
|
|
SolverInfo = SolverInfo0 ^ si_solver_var_map := SolverVarMap,
|
|
solve_absolute(SolverInfo, _SolveCounts, Soln),
|
|
(
|
|
Soln = soln_failure(_),
|
|
unexpected($pred, "cannot solve installed grade string " ++ GradeStr)
|
|
;
|
|
Soln = soln_success(StdSuccMap)
|
|
),
|
|
StdGradeVars = success_map_to_grade_vars(StdSuccMap),
|
|
StdGradeStructure = grade_vars_to_grade_structure(StdGradeVars),
|
|
StdGradeStr = grade_structure_to_grade_string(grade_string_user,
|
|
StdGradeStructure),
|
|
InstalledGrade = installed_grade(StdGradeStr, StdSuccMap).
|
|
|
|
:- pred print_solve_count_stats(io.text_output_stream::in, string::in,
|
|
solve_count_stats::in, io::di, io::uo) is det.
|
|
|
|
print_solve_count_stats(OutStream, Msg, SolveCountStats, !IO) :-
|
|
SolveCountStats = solve_count_stats(TotalNumLabelSteps, TotalNumPasses,
|
|
TotalNumReqTests, NumTests),
|
|
io.format(OutStream, "%s\n", [s(Msg)], !IO),
|
|
io.format(OutStream, "Number of tests: %4d\n",
|
|
[i(NumTests)], !IO),
|
|
( if NumTests > 0 then
|
|
io.format(OutStream, "Average number of label steps: %7.2f\n",
|
|
[f(float(TotalNumLabelSteps) / float(NumTests))], !IO),
|
|
io.format(OutStream, "Average number of passes: %7.2f\n",
|
|
[f(float(TotalNumPasses) / float(NumTests))], !IO),
|
|
io.format(OutStream, "Average number of requirement tests: %7.2f\n",
|
|
[f(float(TotalNumReqTests) / float(NumTests))], !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type test_set_component
|
|
---> test_set_component(
|
|
tsc_solver_var_id :: solver_var_id,
|
|
tsc_solver_var_value_ids :: list(solver_var_value_id)
|
|
).
|
|
|
|
:- type test_component
|
|
---> test_component(
|
|
tc_solver_var_id :: solver_var_id,
|
|
tc_solver_var_value_id :: solver_var_value_id
|
|
).
|
|
|
|
:- type test_set_spec == list(test_set_component).
|
|
:- type test_spec == cord(test_component).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func broad_test_set_spec = test_set_spec.
|
|
|
|
broad_test_set_spec = [
|
|
test_set_component(svar_target,
|
|
[svalue_target_c, svalue_target_csharp, svalue_target_java]),
|
|
test_set_component(svar_trail,
|
|
[svalue_trail_no, svalue_trail_yes]),
|
|
test_set_component(svar_thread_safe,
|
|
[svalue_thread_safe_c_no, svalue_thread_safe_c_yes,
|
|
svalue_thread_safe_target_native]),
|
|
test_set_component(svar_ssdebug,
|
|
[svalue_ssdebug_no, svalue_ssdebug_yes]),
|
|
test_set_component(svar_request_single_prec_float,
|
|
[svalue_request_single_prec_float_no,
|
|
svalue_request_single_prec_float_yes])
|
|
].
|
|
|
|
:- func llds_test_set_spec = test_set_spec.
|
|
|
|
llds_test_set_spec = [
|
|
test_set_component(svar_stack_len,
|
|
[svalue_stack_len_segments, svalue_stack_len_std]),
|
|
test_set_component(svar_thread_safe,
|
|
[svalue_thread_safe_c_no, svalue_thread_safe_c_yes]),
|
|
test_set_component(svar_minmodel,
|
|
[svalue_minmodel_no, svalue_minmodel_stack_copy]),
|
|
test_set_component(svar_deep_prof,
|
|
[svalue_deep_prof_no, svalue_deep_prof_yes]),
|
|
test_set_component(svar_debug,
|
|
[svalue_debug_none, svalue_debug_debug, svalue_debug_decldebug]),
|
|
test_set_component(svar_request_single_prec_float,
|
|
[svalue_request_single_prec_float_no,
|
|
svalue_request_single_prec_float_yes])
|
|
].
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred run_test_sets(io.text_output_stream::in, solver_info::in,
|
|
list(installed_grade_set)::in, list(test_set_spec)::in,
|
|
solve_count_stats::in, solve_count_stats::out,
|
|
solve_count_stats::in, solve_count_stats::out, io::di, io::uo) is det.
|
|
|
|
run_test_sets(_OutStream, _SolverInfo0, _InstalledSets, [],
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO).
|
|
run_test_sets(OutStream, SolverInfo0, InstalledSets, [TestSpec | TestSpecs],
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO) :-
|
|
run_test_set(OutStream, SolverInfo0, InstalledSets, TestSpec, cord.init,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO),
|
|
run_test_sets(OutStream, SolverInfo0, InstalledSets, TestSpecs,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred run_test_set(io.text_output_stream::in, solver_info::in,
|
|
list(installed_grade_set)::in, test_set_spec::in, test_spec::in,
|
|
solve_count_stats::in, solve_count_stats::out,
|
|
solve_count_stats::in, solve_count_stats::out, io::di, io::uo) is det.
|
|
|
|
run_test_set(OutStream, SolverInfo0, InstalledSets,
|
|
TestSetSpec, TestSpecSoFar0,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO) :-
|
|
(
|
|
TestSetSpec = [],
|
|
run_test(OutStream, SolverInfo0, InstalledSets, TestSpecSoFar0,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO)
|
|
;
|
|
TestSetSpec = [TestSetSpecHead | TestSetSpecTail],
|
|
TestSetSpecHead = test_set_component(VarId, ValueIds),
|
|
run_alternatives_for_var(OutStream, SolverInfo0, InstalledSets,
|
|
VarId, ValueIds, TestSetSpecTail, TestSpecSoFar0,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO)
|
|
).
|
|
|
|
:- pred run_alternatives_for_var(io.text_output_stream::in,
|
|
solver_info::in, list(installed_grade_set)::in,
|
|
solver_var_id::in, list(solver_var_value_id)::in,
|
|
test_set_spec::in, test_spec::in,
|
|
solve_count_stats::in, solve_count_stats::out,
|
|
solve_count_stats::in, solve_count_stats::out, io::di, io::uo) is det.
|
|
|
|
run_alternatives_for_var(_OutStream, _SolverInfo0, _InstalledSets, _VarId, [],
|
|
_TestSetSpecTail, _TestSpecSoFar0,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO).
|
|
run_alternatives_for_var(OutStream, SolverInfo0, InstalledSets,
|
|
VarId, [ValueId | ValueIds],
|
|
TestSetSpecTail, TestSpecSoFar0,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO) :-
|
|
solver_var_name(VarName, VarId),
|
|
solver_var_value_name(ValueName, ValueId),
|
|
set_solver_var(VarName, ValueName, VarId, ValueId, set_to_true, npw_user,
|
|
MaybeError, SolverInfo0, SolverInfoForThisAlternative),
|
|
(
|
|
MaybeError = ok
|
|
;
|
|
MaybeError = error(ErrorMsg),
|
|
unexpected($pred, ErrorMsg)
|
|
),
|
|
ThisTestComponent = test_component(VarId, ValueId),
|
|
TestSpecSoFarForThisAlternative =
|
|
cord.snoc(TestSpecSoFar0, ThisTestComponent),
|
|
run_test_set(OutStream, SolverInfoForThisAlternative, InstalledSets,
|
|
TestSetSpecTail, TestSpecSoFarForThisAlternative,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO),
|
|
run_alternatives_for_var(OutStream, SolverInfo0, InstalledSets,
|
|
VarId, ValueIds, TestSetSpecTail, TestSpecSoFar0,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO).
|
|
|
|
:- pred run_test(io.text_output_stream::in, solver_info::in,
|
|
list(installed_grade_set)::in, test_spec::in,
|
|
solve_count_stats::in, solve_count_stats::out,
|
|
solve_count_stats::in, solve_count_stats::out, io::di, io::uo) is det.
|
|
|
|
run_test(OutStream, SolverInfo0, InstalledSets, TestSpec,
|
|
!AbsSolveCountStats, !RelSolveCountStats, !IO) :-
|
|
solve_absolute(SolverInfo0, SolveCounts, Soln),
|
|
accumulate_solve_count_stats(SolveCounts, !AbsSolveCountStats),
|
|
|
|
!.AbsSolveCountStats = solve_count_stats(_, _, _, NumTests),
|
|
SolveCounts = solve_counts(NumLabelSteps, NumPasses, NumReqTests),
|
|
|
|
io.nl(OutStream, !IO),
|
|
io.write_string(OutStream,
|
|
test_spec_to_string("", NumTests, TestSpec), !IO),
|
|
io.format(OutStream,
|
|
"ABS PERF: %2d label steps, %2d passes, %3d requirement tests\n",
|
|
[i(NumLabelSteps), i(NumPasses), i(NumReqTests)], !IO),
|
|
io.write_string(OutStream, soln_to_str(" ", Soln), !IO),
|
|
(
|
|
Soln = soln_failure(_)
|
|
% soln_to_str has already printed FAILURE
|
|
;
|
|
Soln = soln_success(SuccMap),
|
|
GradeVars = success_map_to_grade_vars(SuccMap),
|
|
GradeStructure = grade_vars_to_grade_structure(GradeVars),
|
|
UserGradeStr = grade_structure_to_grade_string(grade_string_user,
|
|
GradeStructure),
|
|
LinkGradeStr = grade_structure_to_grade_string(grade_string_link_check,
|
|
GradeStructure),
|
|
io.format(OutStream, " ABS GRADE USER %s\n",
|
|
[s(UserGradeStr)], !IO),
|
|
io.format(OutStream, " ABS GRADE LINK CHECK %s\n",
|
|
[s(LinkGradeStr)], !IO),
|
|
|
|
list.foldl2(run_installed_grade_set_test(OutStream, SolverInfo0),
|
|
InstalledSets, !RelSolveCountStats, !IO)
|
|
).
|
|
|
|
:- pred run_installed_grade_set_test(io.text_output_stream::in,
|
|
solver_info::in, installed_grade_set::in,
|
|
solve_count_stats::in, solve_count_stats::out, io::di, io::uo) is det.
|
|
|
|
run_installed_grade_set_test(OutStream, SolverInfo, InstalledSet,
|
|
!RelSolveCountStats, !IO) :-
|
|
InstalledSet = installed_grade_set(SetName, InstalledGrades),
|
|
solve_best_installed_grade(SolverInfo, should_commit, InstalledGrades,
|
|
CommitSolveCounts, CommitInstalledGradeSoln),
|
|
solve_best_installed_grade(SolverInfo, should_not_commit, InstalledGrades,
|
|
_NonCommitSolveCounts, NonCommitInstalledGradeSoln),
|
|
accumulate_solve_count_stats(CommitSolveCounts, !RelSolveCountStats),
|
|
io.format(OutStream, " installed grade set %-20s ", [s(SetName)], !IO),
|
|
(
|
|
CommitInstalledGradeSoln = no_such_installed_grade,
|
|
io.write_string(OutStream, "-\n", !IO)
|
|
;
|
|
CommitInstalledGradeSoln = installed_grade_spec_is_inconsistent(_),
|
|
io.write_string(OutStream, "INCONSISTENT\n", !IO)
|
|
;
|
|
CommitInstalledGradeSoln =
|
|
installed_grade_success(ChosenInstalledGrade),
|
|
ChosenInstalledGrade = installed_grade(ChosenInstalledGradeName, _),
|
|
io.format(OutStream, "%s\n", [s(ChosenInstalledGradeName)], !IO)
|
|
),
|
|
( if CommitInstalledGradeSoln = NonCommitInstalledGradeSoln then
|
|
true
|
|
else
|
|
io.write_string(OutStream, "NONCOMMIT IS DIFFERENT%s\n", !IO)
|
|
).
|
|
|
|
:- pred accumulate_solve_count_stats(solve_counts::in,
|
|
solve_count_stats::in, solve_count_stats::out) is det.
|
|
|
|
accumulate_solve_count_stats(SolveCounts, !SolveCountStats) :-
|
|
!.SolveCountStats = solve_count_stats(TotalNumLabelSteps0,
|
|
TotalNumPasses0, TotalNumReqTests0, NumTests0),
|
|
SolveCounts = solve_counts(NumLabelSteps, NumPasses, NumReqTests),
|
|
TotalNumLabelSteps = TotalNumLabelSteps0 + NumLabelSteps,
|
|
TotalNumPasses = TotalNumPasses0 + NumPasses,
|
|
TotalNumReqTests = TotalNumReqTests0 + NumReqTests,
|
|
NumTests = NumTests0 + 1,
|
|
!:SolveCountStats = solve_count_stats(TotalNumLabelSteps,
|
|
TotalNumPasses, TotalNumReqTests, NumTests).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func test_spec_to_string(string, int, test_spec) = string.
|
|
|
|
test_spec_to_string(Prefix, Seq, TestSpec) = Str :-
|
|
string.format("%sTest %d:\n", [s(Prefix), i(Seq)], TestSeqStr),
|
|
TestSpecComponents = cord.to_list(TestSpec),
|
|
TestComponentStrs =
|
|
list.map(test_component_to_string(Prefix), TestSpecComponents),
|
|
Str = string.append_list([TestSeqStr | TestComponentStrs]).
|
|
|
|
:- func test_component_to_string(string, test_component) = string.
|
|
|
|
test_component_to_string(Prefix, TestComponent) = Str :-
|
|
TestComponent = test_component(VarId, ValueId),
|
|
solver_var_name(VarName, VarId),
|
|
solver_var_value_name(ValueName, ValueId),
|
|
string.format("%s%s = %s\n", [s(Prefix), s(VarName), s(ValueName)], Str).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module test_grades.
|
|
%---------------------------------------------------------------------------%
|