[m-rev.] for post-commit review: tabling statistics
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Dec 31 19:14:49 AEDT 2007
Make tabling statistics much more useful, and avoid core dumps while printing
them (thereby fixing bug #23 in Mantis).
runtime/mercury_tabling.h:
Expand the set of statistics we can gather about tabling (starting
to gather information about memory consumption).
Put the statistics into logical groups: enum functors, non-enum
du functors, hash tables, and the expandable table used for I/O
tabling. For du types and polymorphic types, we can gather different
statistics for different parts of a term. We used to use one field
to gather more than one related kind of count, but these are now
separated.
Group the MR_ProcTableInfo struct fields relating to statistics
into substructures. The substructures describing a call or answer
table have their own substructures giving the statistics about the
individual steps; put these in parallel with the descriptions of the
steps themselves.
Put those substructures into two-element arrays to allow them
to be handled uniformly.
runtime/mercury_types.h:
Add the typedefs needed by mercury_tabling.h.
runtime/mercury_tabling_macros.h:
Conform to the modified classification of tabling categories.
runtime/mercury_tabling.c:
runtime/mercury_hash_lookup_or_add_body.h:
runtime/mercury_table_int_fix_index_body.h:
runtime/mercury_table_int_start_index_body.h:
runtime/mercury_table_type_body.h:
runtime/mercury_tabling_stats_defs.h:
runtime/mercury_tabling_stats_nodefs.h:
runtime/mercury_tabling_stats_undefs.h:
Gather the modified and expanded set of statistics.
Use more meaningful names (with MR_ prefixes) for macros.
library/table_builtin.m:
library/table_statistics.m:
Move the material relating to statistics that used to be in
table_builtin.m to the new module table_statistics.m. This is
necessary because table_builtin.m is deliberately not included
in the library documentation, yet users needs to know how to
print out and interpret tabling statistics.
Expand the code for handling statistics, adding predicates for printing
them together with (hopefully explanatory) labels.
Make it all work with the new runtime data structures.
library/library.m:
Include the new library module.
mdbcomp/prim_data.m:
Provide a way to refer to the tabling statistics module.
compiler/hlds_pred.m:
Add utility function to compute the kind of statistics we gather
for a given kind of tabling step.
compiler/rtti.m:
Change the compiler's representation of tabling's runtime data
structures to conform to the change to runtime/mercury_tabling.h.
Replace a bool with a purpose-designed type (is_array),
and add other similar types (call_or_answer_table, curr_or_prev_table).
compiler/rtti_out.m:
compiler/llds_out.m:
Output the updated data structures.
compiler/ml_code_gen.m:
Generate the updated data structures.
compiler/table_gen.m:
Update the C code we generate to gather statistics.
Gather the extra information needed by the updated data structures
in the compiler (to fill in the updated data structures in the
runtime).
compiler/mlds.m:
Add a new kind of constant, one that has just a name. This allows
ml_code_gen.m to avoid lying about the type of constants of enum tyes
(such as the kind of tabling stats we gather for a step).
compiler/modules.m:
Import the new table_statistics module automatically if any tabling
pragma asks for statistics.
compiler/add_pragma.m:
compiler/hlds_out.m:
compiler/llds.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
trace/mercury_trace_cmd_developer.c:
Conform to the changes above.
tests/tabling/fib_stats.{m,exp}:
tests/tabling/specified_stats.{m,exp}:
New test cases to the test tabling statistics.
tests/tabling/Mmakefile:
Enable the new test cases.
tests/tabling/fib.m:
tests/tabling/specified.m:
Clean up the code of these test cases, which were used as the basis
of the new test cases.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.75
diff -u -b -r1.75 add_pragma.m
--- compiler/add_pragma.m 30 Dec 2007 08:23:30 -0000 1.75
+++ compiler/add_pragma.m 30 Dec 2007 08:30:11 -0000
@@ -2745,7 +2745,7 @@
create_tabling_statistics_pred(ProcId, Context, SimpleCallId, SingleProc,
!ProcTable, !Status, !ModuleInfo, !QualInfo, !Specs) :-
- TableBuiltinModule = mercury_table_builtin_module,
+ TableBuiltinModule = mercury_table_statistics_module,
StatsTypeName = qualified(TableBuiltinModule, "proc_table_statistics"),
StatsType = defined_type(StatsTypeName, [], kind_star),
ArgDecl1 = type_and_mode(StatsType, out_mode),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.440
diff -u -b -r1.440 hlds_out.m
--- compiler/hlds_out.m 30 Dec 2007 08:23:42 -0000 1.440
+++ compiler/hlds_out.m 30 Dec 2007 08:30:13 -0000
@@ -4139,10 +4139,13 @@
).
:- pred write_space_and_table_trie_step(tvarset::in,
- table_trie_step::in, io::di, io::uo) is det.
+ table_step_desc::in, io::di, io::uo) is det.
-write_space_and_table_trie_step(TVarSet, TrieStep, !IO) :-
+write_space_and_table_trie_step(TVarSet, StepDesc, !IO) :-
+ StepDesc = table_step_desc(VarName, TrieStep),
io.write_string(" ", !IO),
+ io.write_string(VarName, !IO),
+ io.write_string(":", !IO),
io.write_string(table_trie_step_desc(TVarSet, TrieStep), !IO).
:- func table_trie_step_desc(tvarset, table_trie_step) = string.
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.234
diff -u -b -r1.234 hlds_pred.m
--- compiler/hlds_pred.m 23 Nov 2007 07:35:06 -0000 1.234
+++ compiler/hlds_pred.m 30 Dec 2007 16:57:02 -0000
@@ -43,7 +43,6 @@
:- import_module maybe.
:- import_module pair.
:- import_module set.
-:- import_module table_builtin.
:- implementation.
@@ -324,7 +323,6 @@
% Requests warnings if this predicate is used.
% Used for pragma(obsolete).
-
; marker_user_marked_inline
% The user requests that this be predicate should
% be inlined, even if it exceeds the usual size limits.
@@ -1731,10 +1729,12 @@
---> table_locn_direct(int)
; table_locn_indirect(int, int).
- % This type differs from the type table_step_kind in
- % library/table_builtin.m in that (a) in gives more information about the
- % type of the corresponding argument (if this info is needed and
- % available), and (b) it doesn't have to handle dummy steps.
+ % This type differs from the type table_step_kind in table_statistics.m
+ % in the library in that
+ % (a) in gives more information about the type of the corresponding
+ % argument (if this info is needed and available),
+ % (b) it doesn't have to be an enum, and
+ % (c) it doesn't have to handle dummy steps.
:- type table_trie_step
---> table_trie_step_int
; table_trie_step_char
@@ -1755,6 +1755,21 @@
; table_trie_step_typeclassinfo
; table_trie_step_promise_implied.
+:- type table_is_poly
+ ---> table_is_mono % The table type is monomorphic.
+ ; table_is_poly. % The table type is polymorphic.
+
+:- type table_value_or_addr
+ ---> table_value % We are tabling the value itself.
+ ; table_addr. % We are tabling only the address.
+
+ % Return a description of what kind of statistics we collect for a trie
+ % step of a given kind. The description is the name of a value in the C
+ % enum type MR_TableStepStatsKind. (We will need to generalize this
+ % when we implement tabling for non-C backends.)
+ %
+:- func table_step_stats_kind(table_trie_step) = string.
+
:- type proc_table_io_info
---> proc_table_io_info(
% The information we need to display an I/O action to the user.
@@ -1771,6 +1786,12 @@
table_arg_infos
).
+:- type table_step_desc
+ ---> table_step_desc(
+ tsd_var_name :: string,
+ tsd_step :: table_trie_step
+ ).
+
:- type proc_table_struct_info
---> proc_table_struct_info(
% The information we need to create the data structures
@@ -1801,8 +1822,8 @@
ptsi_context :: prog_context,
ptsi_num_inputs :: int,
ptsi_num_outputs :: int,
- ptsi_input_steps :: list(table_trie_step),
- ptsi_maybe_output_steps :: maybe(list(table_trie_step)),
+ ptsi_input_steps :: list(table_step_desc),
+ ptsi_maybe_output_steps :: maybe(list(table_step_desc)),
ptsi_gen_arg_infos :: table_arg_infos,
ptsi_eval_method :: eval_method
).
@@ -2337,6 +2358,41 @@
structure_reuse_info_init = structure_reuse_info(no, no).
+table_step_stats_kind(Step) = KindStr :-
+ (
+ ( Step = table_trie_step_int
+ ; Step = table_trie_step_char
+ ; Step = table_trie_step_string
+ ; Step = table_trie_step_float
+ ; Step = table_trie_step_typeinfo
+ ; Step = table_trie_step_typeclassinfo
+ ),
+ KindStr = "MR_TABLE_STATS_DETAIL_HASH"
+ ;
+ Step = table_trie_step_enum(_),
+ KindStr = "MR_TABLE_STATS_DETAIL_ENUM"
+ ;
+ Step = table_trie_step_general(_Type, IsPoly, ValueOrAddr),
+ (
+ ValueOrAddr = table_addr,
+ KindStr = "MR_TABLE_STATS_DETAIL_HASH"
+ ;
+ ValueOrAddr = table_value,
+ (
+ IsPoly = table_is_mono,
+ KindStr = "MR_TABLE_STATS_DETAIL_DU"
+ ;
+ IsPoly = table_is_poly,
+ KindStr = "MR_TABLE_STATS_DETAIL_POLY"
+ )
+ )
+ ;
+ ( Step = table_trie_step_promise_implied
+ ; Step = table_trie_step_dummy
+ ),
+ KindStr = "MR_TABLE_STATS_DETAIL_NONE"
+ ).
+
proc_info_init(MContext, Arity, Types, DeclaredModes, Modes, MaybeArgLives,
MaybeDet, IsAddressTaken, VarNameRemap, ProcInfo) :-
% Some parts of the procedure aren't known yet. We initialize them
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.356
diff -u -b -r1.356 llds.m
--- compiler/llds.m 30 Dec 2007 08:23:46 -0000 1.356
+++ compiler/llds.m 30 Dec 2007 08:30:14 -0000
@@ -91,8 +91,8 @@
tis_num_inputs :: int,
tis_num_outputs :: int,
- tis_input_steps :: list(table_trie_step),
- tis_maybe_output_steps :: maybe(list(table_trie_step)),
+ tis_input_steps :: list(table_step_desc),
+ tis_maybe_output_steps :: maybe(list(table_step_desc)),
tis_ptis :: rval,
% Pseudo-typeinfos for headvars.
tis_type_params :: rval,
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.321
diff -u -b -r1.321 llds_out.m
--- compiler/llds_out.m 30 Dec 2007 08:23:47 -0000 1.321
+++ compiler/llds_out.m 30 Dec 2007 08:30:14 -0000
@@ -883,52 +883,40 @@
InfoDataAddr = data_addr(ModuleName,
proc_tabling_ref(ProcLabel, tabling_info)),
InputStepsDataAddr = data_addr(ModuleName,
- proc_tabling_ref(ProcLabel, tabling_input_steps)),
- InputEnumParamsDataAddr = data_addr(ModuleName,
- proc_tabling_ref(ProcLabel, tabling_input_enum_params)),
+ proc_tabling_ref(ProcLabel, tabling_steps_desc(call_table))),
OutputStepsDataAddr = data_addr(ModuleName,
- proc_tabling_ref(ProcLabel, tabling_output_steps)),
- OutputEnumParamsDataAddr = data_addr(ModuleName,
- proc_tabling_ref(ProcLabel, tabling_output_enum_params)),
+ proc_tabling_ref(ProcLabel, tabling_steps_desc(answer_table))),
TipsDataAddr = data_addr(ModuleName,
proc_tabling_ref(ProcLabel, tabling_tips)),
- CallStatsDataName =
- proc_tabling_ref(ProcLabel, tabling_call_stats),
- PrevCallStatsDataName =
- proc_tabling_ref(ProcLabel, tabling_prev_call_stats),
+ CallStatsDataName = proc_tabling_ref(ProcLabel,
+ tabling_stat_steps(call_table, curr_table)),
+ PrevCallStatsDataName = proc_tabling_ref(ProcLabel,
+ tabling_stat_steps(call_table, prev_table)),
CallStatsDataAddr = data_addr(ModuleName, CallStatsDataName),
PrevCallStatsDataAddr = data_addr(ModuleName, PrevCallStatsDataName),
- AnswerStatsDataName =
- proc_tabling_ref(ProcLabel, tabling_answer_stats),
- PrevAnswerStatsDataName =
- proc_tabling_ref(ProcLabel, tabling_prev_answer_stats),
+ AnswerStatsDataName = proc_tabling_ref(ProcLabel,
+ tabling_stat_steps(answer_table, curr_table)),
+ PrevAnswerStatsDataName = proc_tabling_ref(ProcLabel,
+ tabling_stat_steps(answer_table, prev_table)),
AnswerStatsDataAddr = data_addr(ModuleName, AnswerStatsDataName),
PrevAnswerStatsDataAddr = data_addr(ModuleName, PrevAnswerStatsDataName),
InputStepsDataName =
- proc_tabling_ref(ProcLabel, tabling_input_steps),
+ proc_tabling_ref(ProcLabel, tabling_steps_desc(call_table)),
output_table_steps_table(ModuleName, InputStepsDataName, InputSteps,
- MaybeInputStepEnumParams, !DeclSet, !IO),
- InputEnumParamsDataName =
- proc_tabling_ref(ProcLabel, tabling_input_enum_params),
- output_table_enum_params_table(ModuleName, InputEnumParamsDataName,
- MaybeInputStepEnumParams, !DeclSet, !IO),
+ !DeclSet, !IO),
output_rval_decls(PTIVectorRval, !DeclSet, !IO),
(
MaybeOutputSteps = no
;
- MaybeOutputSteps = yes(OutputSteps),
+ MaybeOutputSteps = yes(OutputStepsA),
OutputStepsDataName =
- proc_tabling_ref(ProcLabel, tabling_output_steps),
- output_table_steps_table(ModuleName, OutputStepsDataName, OutputSteps,
- MaybeOutputStepEnumParams, !DeclSet, !IO),
- OutputEnumParamsDataName =
- proc_tabling_ref(ProcLabel, tabling_output_enum_params),
- output_table_enum_params_table(ModuleName, OutputEnumParamsDataName,
- MaybeOutputStepEnumParams, !DeclSet, !IO),
+ proc_tabling_ref(ProcLabel, tabling_steps_desc(answer_table)),
+ output_table_steps_table(ModuleName, OutputStepsDataName, OutputStepsA,
+ !DeclSet, !IO),
output_rval_decls(PTIVectorRval, !DeclSet, !IO)
),
@@ -943,18 +931,18 @@
Stats = table_dont_gather_statistics
;
Stats = table_gather_statistics,
- output_table_stats(ModuleName, CallStatsDataName, NumInputs,
- !DeclSet, !IO),
- output_table_stats(ModuleName, PrevCallStatsDataName, NumInputs,
- !DeclSet, !IO),
+ output_table_step_stats(ModuleName, CallStatsDataName,
+ InputSteps, !DeclSet, !IO),
+ output_table_step_stats(ModuleName, PrevCallStatsDataName,
+ InputSteps, !DeclSet, !IO),
(
MaybeOutputSteps = no
;
- MaybeOutputSteps = yes(_),
- output_table_stats(ModuleName, AnswerStatsDataName, NumOutputs,
- !DeclSet, !IO),
- output_table_stats(ModuleName, PrevAnswerStatsDataName, NumOutputs,
- !DeclSet, !IO)
+ MaybeOutputSteps = yes(OutputStepsB),
+ output_table_step_stats(ModuleName, AnswerStatsDataName,
+ OutputStepsB, !DeclSet, !IO),
+ output_table_step_stats(ModuleName, PrevAnswerStatsDataName,
+ OutputStepsB, !DeclSet, !IO)
)
),
@@ -974,71 +962,79 @@
MaybeOutputSteps = yes(_),
io.write_string("1,\n", !IO)
),
- output_data_addr(InputStepsDataAddr, !IO),
+ io.write_string("(const MR_PseudoTypeInfo *) ", !IO),
+ output_rval(PTIVectorRval, !IO),
io.write_string(",\n", !IO),
- output_data_addr(InputEnumParamsDataAddr, !IO),
+ io.write_string("(const MR_TypeParamLocns *) ", !IO),
+ output_rval(TypeParamsRval, !IO),
+ io.write_string(",\n", !IO),
+ io.write_string("{ 0 },\n", !IO),
+ io.write_string("{\n", !IO),
+ output_data_addr(InputStepsDataAddr, !IO),
io.write_string(",\n", !IO),
(
MaybeOutputSteps = no,
- io.write_string("NULL,\n", !IO),
- io.write_string("NULL,\n", !IO)
+ io.write_string("NULL\n", !IO)
;
MaybeOutputSteps = yes(_),
output_data_addr(OutputStepsDataAddr, !IO),
- io.write_string(",\n", !IO),
- output_data_addr(OutputEnumParamsDataAddr, !IO),
- io.write_string(",\n", !IO)
+ io.write_string("\n", !IO)
),
- io.write_string("(const MR_PseudoTypeInfo *) ", !IO),
- output_rval(PTIVectorRval, !IO),
- io.write_string(",\n", !IO),
- io.write_string("(const MR_TypeParamLocns *) ", !IO),
- output_rval(TypeParamsRval, !IO),
- io.write_string(",\n", !IO),
- io.write_string("{ 0 },\n", !IO),
+ io.write_string("},\n", !IO),
(
Stats = table_dont_gather_statistics,
+ io.write_string("{{{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
- io.write_string("NULL,\n", !IO),
+ io.write_string("NULL\n", !IO),
+ io.write_string("},{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
- io.write_string("NULL,\n", !IO),
+ io.write_string("NULL\n", !IO),
+ io.write_string("}},{{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
- io.write_string("NULL,\n", !IO),
+ io.write_string("NULL\n", !IO),
+ io.write_string("},{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
- io.write_string("NULL,\n", !IO)
+ io.write_string("NULL\n", !IO),
+ io.write_string("}}},\n", !IO)
;
Stats = table_gather_statistics,
+ io.write_string("{{{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
output_data_addr(CallStatsDataAddr, !IO),
- io.write_string(",\n", !IO),
+ io.write_string("\n", !IO),
+ io.write_string("},{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
output_data_addr(PrevCallStatsDataAddr, !IO),
- io.write_string(",\n", !IO),
+ io.write_string("\n", !IO),
+ io.write_string("}},{{\n", !IO),
(
MaybeOutputSteps = no,
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
- io.write_string("NULL,\n", !IO),
+ io.write_string("NULL\n", !IO),
+ io.write_string("},{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
- io.write_string("NULL,\n", !IO)
+ io.write_string("NULL\n", !IO)
;
MaybeOutputSteps = yes(_),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
output_data_addr(AnswerStatsDataAddr, !IO),
- io.write_string(",\n", !IO),
+ io.write_string("\n", !IO),
+ io.write_string("},{\n", !IO),
io.write_string("0,\n", !IO),
io.write_string("0,\n", !IO),
output_data_addr(PrevAnswerStatsDataAddr, !IO),
- io.write_string(",\n", !IO)
- )
+ io.write_string("\n", !IO)
+ ),
+ io.write_string("}}},\n", !IO)
),
(
MaybeSizeLimit = no,
@@ -1058,58 +1054,39 @@
decl_set_insert(decl_data_addr(InfoDataAddr), !DeclSet).
:- pred output_table_steps_table(module_name::in, data_name::in,
- list(table_trie_step)::in, list(maybe(int))::out,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ list(table_step_desc)::in, decl_set::in, decl_set::out, io::di, io::uo)
+ is det.
-output_table_steps_table(ModuleName, DataName, Steps, MaybeEnumParams,
- !DeclSet, !IO) :-
+output_table_steps_table(ModuleName, DataName, StepDescs, !DeclSet, !IO) :-
DataAddr = data_addr(ModuleName, DataName),
io.write_string("\n", !IO),
- io.write_string("static const MR_TableTrieStep ", !IO),
+ io.write_string("static const MR_TableStepDesc ", !IO),
output_data_addr(DataAddr, !IO),
io.write_string("[] = {\n", !IO),
- output_table_steps(Steps, MaybeEnumParams, !IO),
+ output_table_steps(StepDescs, !IO),
io.write_string("};\n", !IO),
decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
-:- pred output_table_steps(list(table_trie_step)::in,
- list(maybe(int))::out, io::di, io::uo) is det.
+:- pred output_table_steps(list(table_step_desc)::in, io::di, io::uo) is det.
-output_table_steps([], [], !IO).
-output_table_steps([Step | Steps], [MaybeEnumParam | MaybeEnumParams],
- !IO) :-
- table_trie_step_to_c(Step, StepType, MaybeEnumParam),
+output_table_steps([], !IO).
+output_table_steps([StepDesc | StepDescs], !IO) :-
+ StepDesc = table_step_desc(VarName, Step),
+ io.write_string("{ """, !IO),
+ c_util.output_quoted_string(VarName, !IO),
+ io.write_string(""", ", !IO),
+ table_trie_step_to_c(Step, StepType, MaybeEnumRange),
io.write_string(StepType, !IO),
- io.write_string(",\n", !IO),
- output_table_steps(Steps, MaybeEnumParams, !IO).
-
-:- pred output_table_enum_params_table(module_name::in, data_name::in,
- list(maybe(int))::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
-
-output_table_enum_params_table(ModuleName, DataName, MaybeEnumParams,
- !DeclSet, !IO) :-
- DataAddr = data_addr(ModuleName, DataName),
- io.write_string("\n", !IO),
- io.write_string("static const MR_Integer ", !IO),
- output_data_addr(DataAddr, !IO),
- io.write_string("[] = {\n", !IO),
- output_table_enum_params(MaybeEnumParams, !IO),
- io.write_string("};\n", !IO),
- decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
-
-:- pred output_table_enum_params(list(maybe(int))::in, io::di, io::uo) is det.
-
-output_table_enum_params([], !IO).
-output_table_enum_params([MaybeEnumParam | MaybeEnumParams], !IO) :-
+ io.write_string(", ", !IO),
(
- MaybeEnumParam = no,
+ MaybeEnumRange = no,
io.write_int(-1, !IO)
;
- MaybeEnumParam = yes(EnumRange),
+ MaybeEnumRange = yes(EnumRange),
io.write_int(EnumRange, !IO)
),
- io.write_string(",\n", !IO),
- output_table_enum_params(MaybeEnumParams, !IO).
+ io.write_string(" },\n", !IO),
+ output_table_steps(StepDescs, !IO).
:- pred output_table_tips(module_name::in, proc_label::in, int::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
@@ -1128,10 +1105,11 @@
io.write_string("];\n", !IO),
decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
-:- pred output_table_stats(module_name::in, data_name::in, int::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+:- pred output_table_step_stats(module_name::in, data_name::in,
+ list(table_step_desc)::in, decl_set::in, decl_set::out, io::di, io::uo)
+ is det.
-output_table_stats(ModuleName, DataName, NumInputs, !DeclSet, !IO) :-
+output_table_step_stats(ModuleName, DataName, Steps, !DeclSet, !IO) :-
% We don't need to initialize the elements of the array, because
% we want to initialize all members of the array to structures
% that contain all zeros, and C does that for us.
@@ -1139,11 +1117,32 @@
io.write_string("\n", !IO),
io.write_string("static MR_TableStepStats ", !IO),
output_data_addr(DataAddr, !IO),
- io.write_string("[", !IO),
- io.write_int(NumInputs, !IO),
- io.write_string("];\n", !IO),
+ io.write_string("[] = \n", !IO),
+ io.write_string("{\n", !IO),
+ output_table_step_stats_2(Steps, !IO),
+ io.write_string("};\n", !IO),
decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
+:- pred output_table_step_stats_2(list(table_step_desc)::in, io::di, io::uo)
+ is det.
+
+output_table_step_stats_2([], !IO).
+output_table_step_stats_2([StepDesc | StepDescs], !IO) :-
+ StepDesc = table_step_desc(_VarName, Step),
+ io.write_string("{ 0, 0, ", !IO),
+ KindStr = table_step_stats_kind(Step),
+ io.write_string(KindStr, !IO),
+ io.write_string(",\n", !IO),
+ % Initialize the fields about hash tables.
+ io.write_string("0, 0, 0, 0, 0, 0, 0, 0, 0, ", !IO),
+ % Initialize the fields about enums.
+ io.write_string("0, 0, ", !IO),
+ % Initialize the fields about du types.
+ io.write_string("0, 0, 0, 0, ", !IO),
+ % Initialize the fields about start tables.
+ io.write_string("0, 0 },\n", !IO),
+ output_table_step_stats_2(StepDescs, !IO).
+
%-----------------------------------------------------------------------------%
:- pred output_static_linkage_define(io::di, io::uo) is det.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.207
diff -u -b -r1.207 ml_code_gen.m
--- compiler/ml_code_gen.m 23 Nov 2007 07:35:13 -0000 1.207
+++ compiler/ml_code_gen.m 23 Nov 2007 07:41:15 -0000
@@ -1074,196 +1074,186 @@
ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel, PredLabel,
_PredModule),
- ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ MLDS_ProcLabel = mlds_proc_label(PredLabel, ProcId),
MLDS_Context = mlds_make_context(Context),
TableTypeStr = eval_method_to_table_type(EvalMethod),
(
InputSteps = [],
% We don't want to generate arrays with zero elements.
- InputStepsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_input_steps)),
- InputEnumParamsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_input_enum_params)),
- InputStepsDefns = [],
- InputEnumParamsDefns = [],
- CallStatsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_call_stats)),
- PrevCallStatsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_prev_call_stats)),
- CallStatsDefns = []
+ InputStepsRefInit = gen_init_null_pointer(
+ mlds_tabling_type(tabling_steps_desc(call_table))),
+ InputStepsDefns = []
;
InputSteps = [_ | _],
- list.map2(table_trie_step_to_c, InputSteps,
- InputStepStrs, InputParams),
- InputStepsInit = init_array(list.map(init_step, InputStepStrs)),
- InputEnumParamsInit = init_array(
- list.map(gen_init_enum_param, InputParams)),
- InputStepsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, const, tabling_input_steps,
- InputStepsInit),
- InputEnumParamsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, const, tabling_input_enum_params,
- InputEnumParamsInit),
- InputStepsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_input_steps),
- InputEnumParamsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_input_enum_params),
- CallStatsInit =
- init_array(list.map(init_stats(tabling_call_stats),
+ InputStepsRefInit = gen_init_tabling_name(MLDS_ModuleName,
+ MLDS_ProcLabel, tabling_steps_desc(call_table)),
+ InputStepsInit = init_array(
+ list.map(init_step_desc(tabling_steps_desc(call_table)),
InputSteps)),
- PrevCallStatsInit =
- init_array(list.map(init_stats(tabling_prev_call_stats),
- InputSteps)),
- CallStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, modifiable, tabling_call_stats,
- CallStatsInit),
- PrevCallStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, modifiable, tabling_prev_call_stats,
- PrevCallStatsInit),
- CallStatsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_call_stats),
- PrevCallStatsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_prev_call_stats),
- InputStepsDefns = [InputStepsDefn],
- InputEnumParamsDefns = [InputEnumParamsDefn],
- CallStatsDefns = [CallStatsDefn, PrevCallStatsDefn]
- ),
+ InputStepsDefns = [tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ MLDS_Context, const, tabling_steps_desc(call_table),
+ InputStepsInit)]
+ ),
+ init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
+ call_table, curr_table, InputSteps,
+ CallStatsInit, CallStatsDefns),
+ init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
+ call_table, prev_table, InputSteps,
+ PrevCallStatsInit, PrevCallStatsDefns),
+ CallDefns = InputStepsDefns ++ CallStatsDefns ++ PrevCallStatsDefns,
(
MaybeOutputSteps = no,
HasAnswerTable = 0,
- OutputStepsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_output_steps)),
- OutputEnumParamsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_output_enum_params)),
- OutputStepsDefns = [],
- OutputEnumParamsDefns = [],
- AnswerStatsDefns = [],
- AnswerStatsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_answer_stats)),
- PrevAnswerStatsName = gen_init_null_pointer(
- mlds_tabling_type(tabling_prev_answer_stats))
+ OutputStepsRefInit = gen_init_null_pointer(
+ mlds_tabling_type(tabling_steps_desc(answer_table))),
+ OutputStepsDefns = []
;
MaybeOutputSteps = yes(OutputSteps),
HasAnswerTable = 1,
- list.map2(table_trie_step_to_c, OutputSteps,
- OutputStepStrs, OutputParams),
- OutputStepsInit = init_array(list.map(init_step, OutputStepStrs)),
- OutputEnumParamsInit = init_array(
- list.map(gen_init_enum_param, OutputParams)),
- OutputStepsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, const, tabling_output_steps,
- OutputStepsInit),
- OutputEnumParamsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, const, tabling_output_enum_params,
- OutputEnumParamsInit),
- OutputStepsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_output_steps),
- OutputEnumParamsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_output_enum_params),
- OutputStepsDefns = [OutputStepsDefn],
- OutputEnumParamsDefns = [OutputEnumParamsDefn],
- AnswerStatsInit =
- init_array(list.map(init_stats(tabling_answer_stats),
+ OutputStepsRefInit = gen_init_tabling_name(MLDS_ModuleName,
+ MLDS_ProcLabel, tabling_steps_desc(answer_table)),
+ OutputStepsInit = init_array(
+ list.map(init_step_desc(tabling_steps_desc(answer_table)),
OutputSteps)),
- PrevAnswerStatsInit =
- init_array(list.map(init_stats(tabling_prev_answer_stats),
- OutputSteps)),
- AnswerStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, modifiable, tabling_answer_stats,
- AnswerStatsInit),
- PrevAnswerStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
- MLDS_Context, modifiable, tabling_prev_answer_stats,
- PrevAnswerStatsInit),
- AnswerStatsDefns = [AnswerStatsDefn, PrevAnswerStatsDefn],
- AnswerStatsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_answer_stats),
- PrevAnswerStatsName = gen_init_tabling_name(MLDS_ModuleName,
- ProcLabel, tabling_prev_answer_stats)
- ),
+ OutputStepsDefns = [tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ MLDS_Context, const, tabling_steps_desc(answer_table),
+ OutputStepsInit)]
+ ),
+ init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
+ answer_table, curr_table, InputSteps,
+ AnswerStatsInit, AnswerStatsDefns),
+ init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
+ answer_table, prev_table, InputSteps,
+ PrevAnswerStatsInit, PrevAnswerStatsDefns),
+ AnswerDefns = OutputStepsDefns ++ AnswerStatsDefns ++ PrevAnswerStatsDefns,
- PTIsName = gen_init_null_pointer(mlds_tabling_type(tabling_ptis)),
- TypeParamLocnsName = gen_init_null_pointer(
+ PTIsRefInit = gen_init_null_pointer(mlds_tabling_type(tabling_ptis)),
+ TypeParamLocnsRefInit = gen_init_null_pointer(
mlds_tabling_type(tabling_type_param_locns)),
- RootNodeName = init_struct(mlds_tabling_type(tabling_root_node),
+ RootNodeInit = init_struct(mlds_tabling_type(tabling_root_node),
[gen_init_int(0)]),
- TipsName = gen_init_null_pointer(mlds_tabling_type(tabling_tips)),
+ TipsRefInit = gen_init_null_pointer(mlds_tabling_type(tabling_tips)),
ProcTableInfoInit = init_struct(mlds_tabling_type(tabling_info), [
gen_init_builtin_const(TableTypeStr),
gen_init_int(NumInputs),
gen_init_int(NumOutputs),
gen_init_int(HasAnswerTable),
- InputStepsName,
- InputEnumParamsName,
- OutputStepsName,
- OutputEnumParamsName,
- PTIsName,
- TypeParamLocnsName,
- RootNodeName,
- gen_init_int(0),
- gen_init_int(0),
- CallStatsName,
- gen_init_int(0),
- gen_init_int(0),
- PrevCallStatsName,
- gen_init_int(0),
- gen_init_int(0),
- AnswerStatsName,
- gen_init_int(0),
- gen_init_int(0),
- PrevAnswerStatsName,
+ PTIsRefInit,
+ TypeParamLocnsRefInit,
+ RootNodeInit,
+ init_array([InputStepsRefInit, OutputStepsRefInit]),
+ init_array([
+ init_array([CallStatsInit, PrevCallStatsInit]),
+ init_array([AnswerStatsInit, PrevAnswerStatsInit])
+ ]),
gen_init_int(0),
- TipsName,
+ TipsRefInit,
gen_init_int(0),
gen_init_int(0)
]),
- ProcTableInfoDefn = tabling_name_and_init_to_defn(ProcLabel, MLDS_Context,
- modifiable, tabling_info, ProcTableInfoInit),
+ ProcTableInfoDefn = tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ MLDS_Context, modifiable, tabling_info, ProcTableInfoInit),
- !:Defns = InputStepsDefns ++ InputEnumParamsDefns ++
- OutputStepsDefns ++ OutputEnumParamsDefns ++
- CallStatsDefns ++ AnswerStatsDefns ++
- [ProcTableInfoDefn | !.Defns].
-
-:- func init_step(string) = mlds_initializer.
-
-init_step(Str) = init_obj(Rval) :-
- PrivateBuiltin = mercury_private_builtin_module,
- MLDS_ModuleName = mercury_module_name_to_mlds(PrivateBuiltin),
- Var = qual(MLDS_ModuleName, module_qual, mlds_var_name(Str, no)),
- % XXX These are actually enumeration constants.
- % Perhaps we should be using an enumeration type here,
- % rather than `mlds_native_int_type'.
- Type = mlds_native_int_type,
- Rval = lval(var(Var, Type)).
+ !:Defns = CallDefns ++ AnswerDefns ++ [ProcTableInfoDefn | !.Defns].
-:- func gen_init_enum_param(maybe(int)) = mlds_initializer.
+:- func init_step_desc(proc_tabling_struct_id, table_step_desc)
+ = mlds_initializer.
-gen_init_enum_param(no) = gen_init_int(-1).
-gen_init_enum_param(yes(NumFunctors)) = gen_init_int(NumFunctors).
+init_step_desc(StructId, StepDesc) = init_struct(StructType, FieldInits) :-
+ StepDesc = table_step_desc(VarName, Step),
+ table_trie_step_to_c(Step, StepStr, MaybeEnumRange),
+ VarNameInit = gen_init_string(VarName),
+ StepInit = encode_enum_init(StepStr),
+ (
+ MaybeEnumRange = no,
+ MaybeEnumRangeInit = gen_init_int(-1)
+ ;
+ MaybeEnumRange = yes(EnumRange),
+ MaybeEnumRangeInit = gen_init_int(EnumRange)
+ ),
+ StructType = mlds_tabling_type(StructId),
+ FieldInits = [VarNameInit, StepInit, MaybeEnumRangeInit].
-:- func gen_init_tabling_name(mlds_module_name, mlds_proc_label,
- proc_tabling_struct_id) = mlds_initializer.
+:- pred init_stats(mlds_module_name::in, mlds_proc_label::in, mlds_context::in,
+ call_or_answer_table::in, curr_or_prev_table::in,
+ list(table_step_desc)::in, mlds_initializer::out, list(mlds_defn)::out)
+ is det.
-gen_init_tabling_name(ModuleName, ProcLabel, TablingId) = Rval :-
- DataAddr = data_addr(ModuleName, mlds_tabling_ref(ProcLabel, TablingId)),
- Rval = init_obj(const(mlconst_data_addr(DataAddr))).
+init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
+ CallOrAnswer, CurrOrPrev, StepDescs, StatsInit, StatsStepDefns) :-
+ StatsId = tabling_stats(CallOrAnswer, CurrOrPrev),
+ StatsStepsId = tabling_stat_steps(CallOrAnswer, CurrOrPrev),
+ StatsType = mlds_tabling_type(StatsId),
+ StatsStepsType = mlds_tabling_type(StatsStepsId),
+ (
+ StepDescs = [],
+ StatsStepDefns = [],
+ StatsStepsArrayRefInit = gen_init_null_pointer(StatsStepsType)
+ ;
+ StepDescs = [_ | _],
+ list.map(init_stats_step(StatsStepsId), StepDescs, StatsStepsInits),
+ StatsStepsArrayInit = init_array(StatsStepsInits),
+ StatsStepDefns = [tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ MLDS_Context, modifiable, StatsStepsId, StatsStepsArrayInit)],
+ StatsStepsArrayRefInit = gen_init_tabling_name(MLDS_ModuleName,
+ MLDS_ProcLabel, tabling_stat_steps(CallOrAnswer, CurrOrPrev))
+ ),
+ StatsInit = init_struct(StatsType, [
+ gen_init_int(0),
+ gen_init_int(0),
+ StatsStepsArrayRefInit
+ ]).
+
+:- pred init_stats_step(proc_tabling_struct_id::in, table_step_desc::in,
+ mlds_initializer::out) is det.
-:- func init_stats(proc_tabling_struct_id, table_trie_step) = mlds_initializer.
+init_stats_step(StepId, StepDesc, Init) :-
+ StepDesc = table_step_desc(_VarName, Step),
+ KindStr = table_step_stats_kind(Step),
+ Init = init_struct(mlds_tabling_type(StepId), [
+ gen_init_int(0),
+ gen_init_int(0),
+ encode_enum_init(KindStr),
-init_stats(Id, _) =
- % Id should be one of tabling_{,prev_}{call,answer}_stats.
- init_struct(mlds_tabling_type(Id), [
+ % The fields about hash tables.
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
gen_init_int(0),
gen_init_int(0),
gen_init_int(0),
gen_init_int(0),
gen_init_int(0),
gen_init_int(0),
+
+ % The fields about enums.
+ gen_init_int(0),
+ gen_init_int(0),
+
+ % The fields about du types.
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+
+ % The fields about start tables.
gen_init_int(0),
gen_init_int(0)
]).
+:- func encode_enum_init(string) = mlds_initializer.
+
+encode_enum_init(EnumConstName) =
+ init_obj(const(mlconst_named_const(EnumConstName))).
+
+:- func gen_init_tabling_name(mlds_module_name, mlds_proc_label,
+ proc_tabling_struct_id) = mlds_initializer.
+
+gen_init_tabling_name(ModuleName, ProcLabel, TablingId) = Rval :-
+ DataAddr = data_addr(ModuleName, mlds_tabling_ref(ProcLabel, TablingId)),
+ Rval = init_obj(const(mlconst_data_addr(DataAddr))).
+
:- func tabling_name_and_init_to_defn(mlds_proc_label, mlds_context, constness,
proc_tabling_struct_id, mlds_initializer) = mlds_defn.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.160
diff -u -b -r1.160 mlds.m
--- compiler/mlds.m 30 Nov 2007 07:51:16 -0000 1.160
+++ compiler/mlds.m 4 Dec 2007 00:05:27 -0000
@@ -1597,6 +1597,15 @@
% A multi_string_const is a string containing embedded NULs
% between each substring in the list.
+ ; mlconst_named_const(string)
+ % A constant with the given name, such as a value of an enum type
+ % in C.
+ % It is the responsibility of the code that creates named constants
+ % to ensure that the constant's name is meaningful for the target
+ % language. This includes making sure that the name is acceptable
+ % as an identifier, does not need quoting, and the constant it
+ % refers to is accessible.
+
; mlconst_code_addr(mlds_code_addr)
; mlconst_data_addr(mlds_data_addr)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.227
diff -u -b -r1.227 mlds_to_c.m
--- compiler/mlds_to_c.m 23 Nov 2007 07:35:15 -0000 1.227
+++ compiler/mlds_to_c.m 23 Nov 2007 07:41:15 -0000
@@ -2453,18 +2453,18 @@
mlds_output_type_suffix(mlds_rtti_type(RttiIdMaybeElement), ArraySize, !IO) :-
IsArrayType = rtti_id_maybe_element_has_array_type(RttiIdMaybeElement),
(
- IsArrayType = yes,
+ IsArrayType = is_array,
mlds_output_array_type_suffix(ArraySize, !IO)
;
- IsArrayType = no
+ IsArrayType = not_array
).
mlds_output_type_suffix(mlds_tabling_type(TablingId), ArraySize, !IO) :-
IsArrayType = tabling_id_has_array_type(TablingId),
(
- IsArrayType = yes,
+ IsArrayType = is_array,
mlds_output_array_type_suffix(ArraySize, !IO)
;
- IsArrayType = no
+ IsArrayType = not_array
).
mlds_output_type_suffix(mlds_unknown_type, _, !IO) :-
unexpected(this_file, "mlds_output_type_suffix: unknown_type").
@@ -3886,6 +3886,8 @@
io.write_string("""", !IO),
c_util.output_quoted_multi_string(String, !IO),
io.write_string("""", !IO).
+mlds_output_rval_const(mlconst_named_const(NamedConst), !IO) :-
+ io.write_string(NamedConst, !IO).
mlds_output_rval_const(mlconst_code_addr(CodeAddr), !IO) :-
mlds_output_code_addr(CodeAddr, !IO).
mlds_output_rval_const(mlconst_data_addr(DataAddr), !IO) :-
@@ -3933,12 +3935,12 @@
% prefix the name with `&'.
(
DataName = mlds_rtti(RttiId),
- rtti_id_has_array_type(RttiId) = yes
+ rtti_id_has_array_type(RttiId) = is_array
->
mlds_output_data_var_name(ModuleName, DataName, !IO)
;
DataName = mlds_tabling_ref(_, TablingId),
- tabling_id_has_array_type(TablingId) = yes
+ tabling_id_has_array_type(TablingId) = is_array
->
mlds_output_data_var_name(ModuleName, DataName, !IO)
;
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.136
diff -u -b -r1.136 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 11 Sep 2007 03:12:31 -0000 1.136
+++ compiler/mlds_to_gcc.m 16 Nov 2007 02:46:07 -0000
@@ -2001,15 +2001,15 @@
(
RttiIdMaybeElement = item_type(_),
(
- IsArray = no,
+ IsArray = not_array,
GCC_Type = BaseType
;
- IsArray = yes,
+ IsArray = is_array,
build_sized_array_type(BaseType, Size, GCC_Type, !IO)
)
;
RttiIdMaybeElement = element_type(_),
- expect(unify(IsArray, yes), this_file,
+ expect(unify(IsArray, is_array), this_file,
"build_rtti_type: element of non-array"),
GCC_Type = BaseType
).
@@ -3681,6 +3681,9 @@
% multi-strings are only used for the debugger.
{ sorry(this_file,
"debugging not yet supported with `--target asm'") }.
+build_rval_const(mlconst_named_const(_NamedConst), _, _Expr) -->
+ { sorry(this_file,
+ "named consts not yet supported with `--target asm'") }.
build_rval_const(mlconst_code_addr(CodeAddr), GlobalInfo, Expr) -->
build_code_addr(CodeAddr, GlobalInfo, Expr).
build_rval_const(mlconst_data_addr(DataAddr), _, Expr) -->
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.195
diff -u -b -r1.195 mlds_to_il.m
--- compiler/mlds_to_il.m 11 Sep 2007 03:12:32 -0000 1.195
+++ compiler/mlds_to_il.m 16 Nov 2007 02:42:49 -0000
@@ -564,6 +564,7 @@
rename_const(mlconst_float(F)) = mlconst_float(F).
rename_const(mlconst_string(S)) = mlconst_string(S).
rename_const(mlconst_multi_string(S)) = mlconst_multi_string(S).
+rename_const(mlconst_named_const(NC)) = mlconst_named_const(NC).
rename_const(mlconst_code_addr(C)) = mlconst_code_addr(rename_code_addr(C)).
rename_const(mlconst_data_addr(A)) = mlconst_data_addr(rename_data_addr(A)).
rename_const(mlconst_null(T)) = mlconst_null(T).
@@ -2402,6 +2403,9 @@
Const = mlconst_multi_string(_MultiString),
Instrs = throw_unimplemented("load multi_string_const")
;
+ Const = mlconst_named_const(_NamedConst),
+ Instrs = throw_unimplemented("load named_const")
+ ;
Const = mlconst_code_addr(CodeAddr),
MethodRef = code_addr_constant_to_methodref(DataRep, CodeAddr),
Instrs = instr_node(ldftn(MethodRef))
@@ -3741,6 +3745,8 @@
rval_const_to_type(mlconst_multi_string(_))
= mercury_type(StrType, type_cat_string, non_foreign_type(StrType)) :-
StrType = builtin_type(builtin_type_string).
+rval_const_to_type(mlconst_named_const(_))
+ = sorry(this_file, "IL backend and named const.").
rval_const_to_type(mlconst_null(MldsType)) = MldsType.
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.100
diff -u -b -r1.100 mlds_to_java.m
--- compiler/mlds_to_java.m 11 Sep 2007 03:12:32 -0000 1.100
+++ compiler/mlds_to_java.m 16 Nov 2007 02:48:01 -0000
@@ -1549,12 +1549,12 @@
io.write_string("new ", !IO),
output_type(StructType, !IO),
IsArray = type_is_array(StructType),
- io.write_string(if IsArray = yes then " {" else "(", !IO),
+ io.write_string(if IsArray = is_array then " {" else "(", !IO),
io.write_list(FieldInits, ",\n\t\t",
(pred(FieldInit::in, !.IO::di, !:IO::uo) is det :-
output_initializer_body(ModuleInfo, FieldInit, no, ModuleName, !IO)
), !IO),
- io.write_char(if IsArray = yes then '}' else ')', !IO).
+ io.write_char(if IsArray = is_array then '}' else ')', !IO).
output_initializer_body(ModuleInfo, init_array(ElementInits), MaybeType,
ModuleName, !IO) :-
io.write_string("new ", !IO),
@@ -1908,19 +1908,19 @@
rtti_id_maybe_element_java_type(RttiIdMaybeElement, JavaTypeName, IsArray),
io.write_string(JavaTypeName, !IO),
(
- IsArray = yes,
+ IsArray = is_array,
io.write_string("[]", !IO)
;
- IsArray = no
+ IsArray = not_array
).
output_type(mlds_tabling_type(TablingId), !IO) :-
tabling_id_java_type(TablingId, JavaTypeName, IsArray),
io.write_string(JavaTypeName, !IO),
(
- IsArray = yes,
+ IsArray = is_array,
io.write_string("[]", !IO)
;
- IsArray = no
+ IsArray = not_array
).
output_type(mlds_unknown_type, !IO) :-
unexpected(this_file, "output_type: unknown type").
@@ -1996,43 +1996,44 @@
unexpected(this_file, "output_mercury_user_type: not a user type")
).
- % return yes if the corresponding Java type is an array type.
-:- func type_is_array(mlds_type) = bool.
+ % Return is_array if the corresponding Java type is an array type.
+ %
+:- func type_is_array(mlds_type) = is_array.
type_is_array(Type) = IsArray :-
( Type = mlds_array_type(_) ->
- IsArray = yes
+ IsArray = is_array
; Type = mlds_mercury_array_type(_) ->
- IsArray = yes
+ IsArray = is_array
; Type = mercury_type(_, TypeCategory, _) ->
IsArray = type_category_is_array(TypeCategory)
; Type = mlds_rtti_type(RttiIdMaybeElement) ->
rtti_id_maybe_element_java_type(RttiIdMaybeElement,
_JavaTypeName, IsArray)
;
- IsArray = no
+ IsArray = not_array
).
- % Return yes if the corresponding Java type is an array type.
+ % Return is_array if the corresponding Java type is an array type.
%
-:- func type_category_is_array(type_category) = bool.
+:- func type_category_is_array(type_category) = is_array.
-type_category_is_array(type_cat_int) = no.
-type_category_is_array(type_cat_char) = no.
-type_category_is_array(type_cat_string) = no.
-type_category_is_array(type_cat_float) = no.
-type_category_is_array(type_cat_higher_order) = yes.
-type_category_is_array(type_cat_tuple) = yes.
-type_category_is_array(type_cat_enum) = no.
-type_category_is_array(type_cat_foreign_enum) = no.
-type_category_is_array(type_cat_dummy) = no.
-type_category_is_array(type_cat_variable) = no.
-type_category_is_array(type_cat_type_info) = no.
-type_category_is_array(type_cat_type_ctor_info) = no.
-type_category_is_array(type_cat_typeclass_info) = yes.
-type_category_is_array(type_cat_base_typeclass_info) = yes.
-type_category_is_array(type_cat_void) = no.
-type_category_is_array(type_cat_user_ctor) = no.
+type_category_is_array(type_cat_int) = not_array.
+type_category_is_array(type_cat_char) = not_array.
+type_category_is_array(type_cat_string) = not_array.
+type_category_is_array(type_cat_float) = not_array.
+type_category_is_array(type_cat_higher_order) = is_array.
+type_category_is_array(type_cat_tuple) = is_array.
+type_category_is_array(type_cat_enum) = not_array.
+type_category_is_array(type_cat_foreign_enum) = not_array.
+type_category_is_array(type_cat_dummy) = not_array.
+type_category_is_array(type_cat_variable) = not_array.
+type_category_is_array(type_cat_type_info) = not_array.
+type_category_is_array(type_cat_type_ctor_info) = not_array.
+type_category_is_array(type_cat_typeclass_info) = is_array.
+type_category_is_array(type_cat_base_typeclass_info) = is_array.
+type_category_is_array(type_cat_void) = not_array.
+type_category_is_array(type_cat_user_ctor) = not_array.
% hand_defined_type(Type, SubstituteName):
%
@@ -2830,7 +2831,9 @@
;
output_type(Type, !IO)
),
- ( type_is_array(Type) = yes ->
+ IsArray = type_is_array(Type),
+ (
+ IsArray = is_array,
% The new object will be an array, so we need to initialise it
% using array literals syntax.
io.write_string(" {", !IO),
@@ -2838,6 +2841,7 @@
!IO),
io.write_string("};\n", !IO)
;
+ IsArray = not_array,
% Generate constructor arguments.
io.write_string("(", !IO),
output_init_args(ModuleInfo, Args, ArgTypes, 0, HasSecTag, ModuleName,
@@ -3323,6 +3327,9 @@
c_util.output_quoted_multi_string(String, !IO),
io.write_string("""", !IO).
+output_rval_const(mlconst_named_const(NamedConst), !IO) :-
+ io.write_string(NamedConst, !IO).
+
output_rval_const(mlconst_code_addr(CodeAddr), !IO) :-
IsCall = no,
mlds_output_code_addr(CodeAddr, IsCall, !IO).
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.48
diff -u -b -r1.48 mlds_to_managed.m
--- compiler/mlds_to_managed.m 11 Sep 2007 03:12:32 -0000 1.48
+++ compiler/mlds_to_managed.m 16 Nov 2007 02:44:53 -0000
@@ -481,6 +481,8 @@
io.write_string("""", !IO),
c_util.output_quoted_multi_string(S, !IO),
io.write_string("""", !IO).
+write_rval_const(mlconst_named_const(NamedConst), !IO) :-
+ io.write_string(NamedConst, !IO).
write_rval_const(mlconst_code_addr(CodeAddrConst), !IO) :-
(
CodeAddrConst = code_addr_proc(ProcLabel, _FuncSignature),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.442
diff -u -b -r1.442 modules.m
--- compiler/modules.m 5 Dec 2007 05:07:35 -0000 1.442
+++ compiler/modules.m 7 Dec 2007 01:39:59 -0000
@@ -2906,24 +2906,17 @@
list(module_name)::in, list(module_name)::out) is det.
add_implicit_imports(Items, Globals, !ImportDeps, !UseDeps) :-
- MercuryPublicBuiltin = mercury_public_builtin_module,
- MercuryPrivateBuiltin = mercury_private_builtin_module,
- MercuryTableBuiltin = mercury_table_builtin_module,
- MercuryProfilingBuiltin = mercury_profiling_builtin_module,
- MercuryTermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
- MercuryParBuiltin = mercury_par_builtin_module,
- MercuryRegionBuiltin = mercury_region_builtin_module,
- !:ImportDeps = [MercuryPublicBuiltin | !.ImportDeps],
- !:UseDeps = [MercuryPrivateBuiltin | !.UseDeps],
+ !:ImportDeps = [mercury_public_builtin_module | !.ImportDeps],
+ !:UseDeps = [mercury_private_builtin_module | !.UseDeps],
(
- %
- % We should include MercuryTableBuiltin if the Items contain
+ % We should include mercury_table_builtin_module if the Items contain
% a tabling pragma, or if one of --use-minimal-model and
% --trace-table-io is specified.
- %
- (
- contains_tabling_pragma(Items)
+
+ ( contains_tabling_pragma(Items, HasStatsPrime) ->
+ HasStats = HasStatsPrime
;
+ (
globals.lookup_bool_option(Globals,
use_minimal_model_stack_copy, yes)
;
@@ -2931,16 +2924,24 @@
use_minimal_model_own_stacks, yes)
;
globals.lookup_bool_option(Globals, trace_table_io, yes)
+ ),
+ HasStats = table_dont_gather_statistics
)
->
- !:UseDeps = [MercuryTableBuiltin | !.UseDeps]
+ !:UseDeps = [mercury_table_builtin_module | !.UseDeps],
+ (
+ HasStats = table_dont_gather_statistics
+ ;
+ HasStats = table_gather_statistics,
+ !:UseDeps = [mercury_table_statistics_module | !.UseDeps]
+ )
;
true
),
globals.lookup_bool_option(Globals, profile_deep, Deep),
(
Deep = yes,
- !:UseDeps = [MercuryProfilingBuiltin | !.UseDeps]
+ !:UseDeps = [mercury_profiling_builtin_module | !.UseDeps]
;
Deep = no
),
@@ -2953,7 +2954,7 @@
record_term_sizes_as_cells, yes)
)
->
- !:UseDeps = [MercuryTermSizeProfBuiltin | !.UseDeps]
+ !:UseDeps = [mercury_term_size_prof_builtin_module | !.UseDeps]
;
true
),
@@ -2965,14 +2966,14 @@
HighLevelCode = no,
Parallel = yes
->
- !:UseDeps = [MercuryParBuiltin | !.UseDeps]
+ !:UseDeps = [mercury_par_builtin_module | !.UseDeps]
;
true
),
globals.lookup_bool_option(Globals, use_regions, UseRegions),
(
UseRegions = yes,
- !:UseDeps = [MercuryRegionBuiltin | !.UseDeps]
+ !:UseDeps = [mercury_region_builtin_module | !.UseDeps]
;
UseRegions = no
),
@@ -2984,14 +2985,45 @@
SSDB = no
).
-:- pred contains_tabling_pragma(item_list::in) is semidet.
+:- pred contains_tabling_pragma(item_list::in, table_attr_statistics::out)
+ is semidet.
-contains_tabling_pragma([ItemAndContext | ItemAndContexts]) :-
+contains_tabling_pragma(ItemAndContexts, HasStats) :-
+ contains_tabling_pragma_2(ItemAndContexts, no, HasTabling,
+ table_dont_gather_statistics, HasStats),
+ HasTabling = yes.
+
+:- pred contains_tabling_pragma_2(item_list::in, bool::in, bool::out,
+ table_attr_statistics::in, table_attr_statistics::out) is det.
+
+contains_tabling_pragma_2([], !HasTabling, !HasStats).
+contains_tabling_pragma_2([ItemAndContext | ItemAndContexts],
+ !HasTabling, !HasStats) :-
+ ItemAndContext = item_and_context(Item, _Context),
(
- ItemAndContext = item_and_context(item_pragma(_, Pragma), _Context),
- Pragma = pragma_tabled(_, _, _, _, _, _)
+ Item = item_pragma(_, Pragma),
+ Pragma = pragma_tabled(_, _, _, _, _, MaybeAttributes)
+ ->
+ !:HasTabling = yes,
+ (
+ MaybeAttributes = no,
+ contains_tabling_pragma_2(ItemAndContexts, !HasTabling, !HasStats)
+ ;
+ MaybeAttributes = yes(Attributes),
+ StatsAttr = Attributes ^ table_attr_statistics,
+ (
+ StatsAttr = table_gather_statistics,
+ !:HasStats = table_gather_statistics
+ % We can stop recursing; later items cannot change the result.
+ ;
+ StatsAttr = table_dont_gather_statistics,
+ % Leave !HasStats as it is.
+ contains_tabling_pragma_2(ItemAndContexts,
+ !HasTabling, !HasStats)
+ )
+ )
;
- contains_tabling_pragma(ItemAndContexts)
+ contains_tabling_pragma_2(ItemAndContexts, !HasTabling, !HasStats)
).
% Warn if a module imports itself, or an ancestor.
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.87
diff -u -b -r1.87 rtti.m
--- compiler/rtti.m 23 Nov 2007 07:35:23 -0000 1.87
+++ compiler/rtti.m 23 Nov 2007 07:41:16 -0000
@@ -704,12 +704,16 @@
% The type is the type of the elements of the data structure
% identified by the rtti_id, which must be an array.
- % Return yes iff the specified entity is an array.
- %
-:- func rtti_id_maybe_element_has_array_type(rtti_id_maybe_element) = bool.
-:- func rtti_id_has_array_type(rtti_id) = bool.
-:- func ctor_rtti_name_has_array_type(ctor_rtti_name) = bool.
-:- func tc_rtti_name_has_array_type(tc_rtti_name) = bool.
+:- type is_array
+ ---> is_array
+ ; not_array.
+
+ % Return is_array iff the specified entity is an array.
+ %
+:- func rtti_id_maybe_element_has_array_type(rtti_id_maybe_element) = is_array.
+:- func rtti_id_has_array_type(rtti_id) = is_array.
+:- func ctor_rtti_name_has_array_type(ctor_rtti_name) = is_array.
+:- func tc_rtti_name_has_array_type(tc_rtti_name) = is_array.
% Return yes iff the specified entity should be exported
% for use by other modules.
@@ -827,21 +831,21 @@
% after the name.
%
:- pred rtti_id_maybe_element_c_type(rtti_id_maybe_element::in, string::out,
- bool::out) is det.
-:- pred rtti_id_c_type(rtti_id::in, string::out, bool::out) is det.
-:- pred ctor_rtti_name_c_type(ctor_rtti_name::in, string::out, bool::out)
+ is_array::out) is det.
+:- pred rtti_id_c_type(rtti_id::in, string::out, is_array::out) is det.
+:- pred ctor_rtti_name_c_type(ctor_rtti_name::in, string::out, is_array::out)
is det.
-:- pred tc_rtti_name_c_type(tc_rtti_name::in, string::out, bool::out)
+:- pred tc_rtti_name_c_type(tc_rtti_name::in, string::out, is_array::out)
is det.
% Analogous to rtti_id_c_type.
%
:- pred rtti_id_maybe_element_java_type(rtti_id_maybe_element::in, string::out,
- bool::out) is det.
-:- pred rtti_id_java_type(rtti_id::in, string::out, bool::out) is det.
-:- pred ctor_rtti_name_java_type(ctor_rtti_name::in, string::out, bool::out)
- is det.
-:- pred tc_rtti_name_java_type(tc_rtti_name::in, string::out, bool::out)
+ is_array::out) is det.
+:- pred rtti_id_java_type(rtti_id::in, string::out, is_array::out) is det.
+:- pred ctor_rtti_name_java_type(ctor_rtti_name::in, string::out,
+ is_array::out) is det.
+:- pred tc_rtti_name_java_type(tc_rtti_name::in, string::out, is_array::out)
is det.
% Given a type in a type vector in a type class instance declaration,
@@ -865,31 +869,20 @@
%----------------------------------------------------------------------------%
+:- type call_or_answer_table
+ ---> call_table
+ ; answer_table.
+
+:- type curr_or_prev_table
+ ---> curr_table
+ ; prev_table.
+
:- type proc_tabling_struct_id
---> tabling_info
% A reference to the main structure containing the call table
% used to implement memoization, loop checking or minimal model
% semantics for the given procedure.
- ; tabling_input_steps
- % A reference to the part of the tabling structure for the given
- % procedure that gives the nature of each step in the call table.
-
- ; tabling_output_steps
- % A reference to the part of the tabling structure for the given
- % procedure that gives the nature of each step in the answer table
- % (if any).
-
- ; tabling_input_enum_params
- % A reference to the part of the tabling structure for the given
- % procedure that gives parameters for the call table steps
- % corresponding to enums.
-
- ; tabling_output_enum_params
- % A reference to the part of the tabling structure for the given
- % procedure that gives parameters for the answer table steps
- % (if any) corresponding to enums.
-
; tabling_ptis
% A reference to the part of the tabling structure for the given
% procedure that contains pointers to the pseudotypeinfos
@@ -905,25 +898,22 @@
% A reference to the part of the tabling structure for the given
% procedure that contains the root of the call table.
- ; tabling_call_stats
- % A reference to the part of the tabling structure for the given
- % procedure that refers to the current cumulative statistics
- % about operations on the call table.
-
- ; tabling_prev_call_stats
+ ; tabling_steps_desc(call_or_answer_table)
% A reference to the part of the tabling structure for the given
- % procedure that refers to the previous snapshot of statistics
- % about operations on the call table.
+ % procedure that gives the nature of each step in the call or
+ % answer table.
- ; tabling_answer_stats
+ ; tabling_stats(call_or_answer_table, curr_or_prev_table)
% A reference to the part of the tabling structure for the given
- % procedure that refers to the current cumulative statistics
- % about operations on the answer table.
+ % procedure that refers to the either the current or the previous
+ % versions of the statistics about overall operations on the
+ % call or answer table.
- ; tabling_prev_answer_stats
+ ; tabling_stat_steps(call_or_answer_table, curr_or_prev_table)
% A reference to the part of the tabling structure for the given
- % procedure that refers to the previous snapshot of statistics
- % about operations on the answer table.
+ % procedure that refers to the either the current or the previous
+ % versions of the statistics about operations on the steps of the
+ % call or answer table.
; tabling_tips.
% A reference to the part of the tabling structure for the given
@@ -935,16 +925,16 @@
% tabling_id_c_type(TablingId, Type, IsArray):
%
% To declare a variable of the type specified by TablingId, put Type
- % before the name of the variable; if IsArray is true, also put "[]"
+ % before the name of the variable; if IsArray = is_array, also put "[]"
% after the name.
%
:- pred tabling_id_c_type(proc_tabling_struct_id::in, string::out,
- bool::out) is det.
+ is_array::out) is det.
:- pred tabling_id_java_type(proc_tabling_struct_id::in, string::out,
- bool::out) is det.
+ is_array::out) is det.
-:- func tabling_id_has_array_type(proc_tabling_struct_id) = bool.
+:- func tabling_id_has_array_type(proc_tabling_struct_id) = is_array.
:- pred table_trie_step_to_c(table_trie_step::in, string::out, maybe(int)::out)
is det.
@@ -1059,8 +1049,8 @@
rtti_id_maybe_element_has_array_type(item_type(RttiId)) =
rtti_id_has_array_type(RttiId).
-rtti_id_maybe_element_has_array_type(element_type(RttiId)) = no :-
- expect(unify(rtti_id_has_array_type(RttiId), yes), this_file,
+rtti_id_maybe_element_has_array_type(element_type(RttiId)) = not_array :-
+ expect(unify(rtti_id_has_array_type(RttiId), is_array), this_file,
"rtti_id_maybe_element_has_array_type: base is not array").
rtti_id_has_array_type(ctor_rtti_id(_, RttiName)) =
@@ -1829,12 +1819,12 @@
rtti_id_maybe_element_c_type(element_type(RttiId), CTypeName, IsArray) :-
rtti_id_c_type(RttiId, CTypeName, IsArray0),
(
- IsArray0 = no,
+ IsArray0 = not_array,
unexpected(this_file,
"rtti_id_maybe_element_c_type: base is not array")
;
- IsArray0 = yes,
- IsArray = no
+ IsArray0 = is_array,
+ IsArray = not_array
).
rtti_id_c_type(ctor_rtti_id(_, RttiName), CTypeName, IsArray) :-
@@ -1855,12 +1845,12 @@
rtti_id_maybe_element_java_type(element_type(RttiId), CTypeName, IsArray) :-
rtti_id_java_type(RttiId, CTypeName, IsArray0),
(
- IsArray0 = no,
+ IsArray0 = not_array,
unexpected(this_file,
"rtti_id_maybe_element_java_type: base is not array")
;
- IsArray0 = yes,
- IsArray = no
+ IsArray0 = is_array,
+ IsArray = not_array
).
rtti_id_java_type(ctor_rtti_id(_, RttiName), JavaTypeName, IsArray) :-
@@ -1938,95 +1928,104 @@
JavaTypeName = "mercury.runtime." ++ GenTypeName
).
- % ctor_rtti_name_type(RttiName, Type, IsArray):
-:- pred ctor_rtti_name_type(ctor_rtti_name::in, string::out, bool::out) is det.
+ % ctor_rtti_name_type(RttiName, Type, IsArray)
+ %
+:- pred ctor_rtti_name_type(ctor_rtti_name::in, string::out, is_array::out)
+ is det.
ctor_rtti_name_type(type_ctor_exist_locns(_),
- "DuExistLocn", yes).
+ "DuExistLocn", is_array).
ctor_rtti_name_type(type_ctor_exist_locn,
- "DuExistLocn", no).
+ "DuExistLocn", not_array).
ctor_rtti_name_type(type_ctor_exist_tc_constr(_, _, N),
- tc_constraint_type_name(N), no).
+ tc_constraint_type_name(N), not_array).
ctor_rtti_name_type(type_ctor_exist_tc_constrs(_),
- "TypeClassConstraint", yes).
+ "TypeClassConstraint", is_array).
ctor_rtti_name_type(type_ctor_exist_info(_),
- "DuExistInfo", no).
+ "DuExistInfo", not_array).
ctor_rtti_name_type(type_ctor_field_names(_),
- "ConstString", yes).
+ "ConstString", is_array).
ctor_rtti_name_type(type_ctor_field_types(_),
- "PseudoTypeInfo", yes).
+ "PseudoTypeInfo", is_array).
ctor_rtti_name_type(type_ctor_res_addrs,
- "ReservedAddr", yes).
+ "ReservedAddr", is_array).
ctor_rtti_name_type(type_ctor_res_addr_functors,
- "ReservedAddrFunctorDescPtr", yes).
+ "ReservedAddrFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_enum_functor_desc(_),
- "EnumFunctorDesc", no).
+ "EnumFunctorDesc", not_array).
ctor_rtti_name_type(type_ctor_foreign_enum_functor_desc(_),
- "ForeignEnumFunctorDesc", no).
+ "ForeignEnumFunctorDesc", not_array).
ctor_rtti_name_type(type_ctor_notag_functor_desc,
- "NotagFunctorDesc", no).
+ "NotagFunctorDesc", not_array).
ctor_rtti_name_type(type_ctor_du_functor_desc(_),
- "DuFunctorDesc", no).
+ "DuFunctorDesc", not_array).
ctor_rtti_name_type(type_ctor_res_functor_desc(_),
- "ReservedAddrFunctorDesc", no).
+ "ReservedAddrFunctorDesc", not_array).
ctor_rtti_name_type(type_ctor_enum_name_ordered_table,
- "EnumFunctorDescPtr", yes).
+ "EnumFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_enum_value_ordered_table,
- "EnumFunctorDescPtr", yes).
+ "EnumFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_foreign_enum_name_ordered_table,
- "ForeignEnumFunctorDescPtr", yes).
+ "ForeignEnumFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_foreign_enum_ordinal_ordered_table,
- "ForeignEnumFunctorDescPtr", yes).
+ "ForeignEnumFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_du_name_ordered_table,
- "DuFunctorDescPtr", yes).
+ "DuFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_du_stag_ordered_table(_),
- "DuFunctorDescPtr", yes).
+ "DuFunctorDescPtr", is_array).
ctor_rtti_name_type(type_ctor_du_ptag_ordered_table,
- "DuPtagLayout", yes).
+ "DuPtagLayout", is_array).
ctor_rtti_name_type(type_ctor_du_ptag_layout(_),
- "DuPtagLayout", no).
+ "DuPtagLayout", not_array).
ctor_rtti_name_type(type_ctor_res_value_ordered_table,
- "ReservedAddrTypeLayout", no).
+ "ReservedAddrTypeLayout", not_array).
ctor_rtti_name_type(type_ctor_res_name_ordered_table,
- "MaybeResAddrFunctorDesc", yes).
+ "MaybeResAddrFunctorDesc", is_array).
ctor_rtti_name_type(type_ctor_maybe_res_addr_functor_desc,
- "MaybeResAddrFunctorDesc", no).
+ "MaybeResAddrFunctorDesc", not_array).
ctor_rtti_name_type(type_ctor_functor_number_map,
- "Integer", yes).
+ "Integer", is_array).
ctor_rtti_name_type(type_ctor_type_functors,
- "TypeFunctors", no).
+ "TypeFunctors", not_array).
ctor_rtti_name_type(type_ctor_type_layout,
- "TypeLayout", no).
+ "TypeLayout", not_array).
ctor_rtti_name_type(type_ctor_type_ctor_info,
- "TypeCtorInfo_Struct", no).
+ "TypeCtorInfo_Struct", not_array).
ctor_rtti_name_type(type_ctor_type_hashcons_pointer,
- "TrieNodePtr", no).
+ "TrieNodePtr", not_array).
ctor_rtti_name_type(type_ctor_type_info(TypeInfo),
- type_info_name_type(TypeInfo), no).
+ type_info_name_type(TypeInfo), not_array).
ctor_rtti_name_type(type_ctor_pseudo_type_info(PseudoTypeInfo),
- pseudo_type_info_name_type(PseudoTypeInfo), no).
+ pseudo_type_info_name_type(PseudoTypeInfo), not_array).
- % tc_rtti_name_type(RttiName, Type, IsArray):
+ % tc_rtti_name_type(RttiName, Type, IsArray)
%
-:- pred tc_rtti_name_type(tc_rtti_name::in, string::out, bool::out) is det.
+:- pred tc_rtti_name_type(tc_rtti_name::in, string::out, is_array::out) is det.
tc_rtti_name_type(type_class_base_typeclass_info(_, _),
- "BaseTypeclassInfo", yes).
-tc_rtti_name_type(type_class_id, "TypeClassId", no).
-tc_rtti_name_type(type_class_id_var_names, "ConstString", yes).
-tc_rtti_name_type(type_class_id_method_ids, "TypeClassMethod", yes).
-tc_rtti_name_type(type_class_decl, "TypeClassDeclStruct", no).
-tc_rtti_name_type(type_class_decl_super(_, N), TypeName, no) :-
+ "BaseTypeclassInfo", is_array).
+tc_rtti_name_type(type_class_id,
+ "TypeClassId", not_array).
+tc_rtti_name_type(type_class_id_var_names,
+ "ConstString", is_array).
+tc_rtti_name_type(type_class_id_method_ids,
+ "TypeClassMethod", is_array).
+tc_rtti_name_type(type_class_decl,
+ "TypeClassDeclStruct", not_array).
+tc_rtti_name_type(type_class_decl_super(_, N), TypeName, not_array) :-
TypeName = tc_constraint_type_name(N).
-tc_rtti_name_type(type_class_decl_supers, "TypeClassConstraint", yes).
-tc_rtti_name_type(type_class_instance(_), "InstanceStruct", no).
+tc_rtti_name_type(type_class_decl_supers,
+ "TypeClassConstraint", is_array).
+tc_rtti_name_type(type_class_instance(_),
+ "InstanceStruct", not_array).
tc_rtti_name_type(type_class_instance_tc_type_vector(_),
- "PseudoTypeInfo", yes).
-tc_rtti_name_type(type_class_instance_constraint(_, _, N), TypeName, no) :-
+ "PseudoTypeInfo", is_array).
+tc_rtti_name_type(type_class_instance_constraint(_, _, N),
+ TypeName, not_array) :-
TypeName = tc_constraint_type_name(N).
tc_rtti_name_type(type_class_instance_constraints(_),
- "TypeClassConstraint", yes).
-tc_rtti_name_type(type_class_instance_methods(_), "CodePtr", yes).
+ "TypeClassConstraint", is_array).
+tc_rtti_name_type(type_class_instance_methods(_), "CodePtr", is_array).
:- func tc_constraint_type_name(int) = string.
@@ -2115,17 +2114,27 @@
%-----------------------------------------------------------------------------%
tabling_info_id_str(tabling_info) = "table_info".
-tabling_info_id_str(tabling_input_steps) = "table_input_steps".
-tabling_info_id_str(tabling_output_steps) = "table_output_steps".
-tabling_info_id_str(tabling_input_enum_params) = "table_input_enum_params".
-tabling_info_id_str(tabling_output_enum_params) = "table_output_enum_params".
tabling_info_id_str(tabling_ptis) = "table_ptis".
tabling_info_id_str(tabling_type_param_locns) = "tabling_type_param_locns".
tabling_info_id_str(tabling_root_node) = "table_root_node".
-tabling_info_id_str(tabling_call_stats) = "table_call_stats".
-tabling_info_id_str(tabling_prev_call_stats) = "table_prev_call_stats".
-tabling_info_id_str(tabling_answer_stats) = "table_answer_stats".
-tabling_info_id_str(tabling_prev_answer_stats) = "table_prev_answer_stats".
+tabling_info_id_str(tabling_steps_desc(call_table)) = "table_input_steps".
+tabling_info_id_str(tabling_steps_desc(answer_table)) = "table_output_steps".
+tabling_info_id_str(tabling_stats(call_table, curr_table)) =
+ "table_call_stats".
+tabling_info_id_str(tabling_stats(call_table, prev_table)) =
+ "table_prev_call_stats".
+tabling_info_id_str(tabling_stats(answer_table, curr_table)) =
+ "table_answer_stats".
+tabling_info_id_str(tabling_stats(answer_table, prev_table)) =
+ "table_prev_answer_stats".
+tabling_info_id_str(tabling_stat_steps(call_table, curr_table)) =
+ "table_call_step_stats".
+tabling_info_id_str(tabling_stat_steps(call_table, prev_table)) =
+ "table_prev_call_step_stats".
+tabling_info_id_str(tabling_stat_steps(answer_table, curr_table)) =
+ "table_answer_step_stats".
+tabling_info_id_str(tabling_stat_steps(answer_table, prev_table)) =
+ "table_prev_answer_step_stats".
tabling_info_id_str(tabling_tips) = "table_tips".
tabling_id_c_type(Id, JavaTypeName, IsArray) :-
@@ -2139,21 +2148,17 @@
JavaTypeName = "mercury.runtime." ++ CTypeName.
:- pred tabling_id_base_type(proc_tabling_struct_id::in, string::out,
- bool::out) is det.
+ is_array::out) is det.
-tabling_id_base_type(tabling_info, "ProcTableInfo", no).
-tabling_id_base_type(tabling_input_steps, "TableTrieStep", yes).
-tabling_id_base_type(tabling_output_steps, "TableTrieStep", yes).
-tabling_id_base_type(tabling_input_enum_params, "Integer", yes).
-tabling_id_base_type(tabling_output_enum_params, "Integer", yes).
-tabling_id_base_type(tabling_ptis, "PseudoTypeInfo", yes).
-tabling_id_base_type(tabling_type_param_locns, "MR_TypeParamLocns", yes).
-tabling_id_base_type(tabling_root_node, "TableNode", no).
-tabling_id_base_type(tabling_call_stats, "TableStepStats", yes).
-tabling_id_base_type(tabling_prev_call_stats, "TableStepStats", yes).
-tabling_id_base_type(tabling_answer_stats, "TableStepStats", yes).
-tabling_id_base_type(tabling_prev_answer_stats, "TableStepStats", yes).
-tabling_id_base_type(tabling_tips, "TrieNode", yes).
+% These should be without the MR_ prefix.
+tabling_id_base_type(tabling_info, "ProcTableInfo", not_array).
+tabling_id_base_type(tabling_ptis, "PseudoTypeInfo", is_array).
+tabling_id_base_type(tabling_type_param_locns, "TypeParamLocns", is_array).
+tabling_id_base_type(tabling_root_node, "TableNode", not_array).
+tabling_id_base_type(tabling_steps_desc(_), "TableStepDesc", is_array).
+tabling_id_base_type(tabling_stats(_, _), "TableStats", not_array).
+tabling_id_base_type(tabling_stat_steps(_, _), "TableStepStats", is_array).
+tabling_id_base_type(tabling_tips, "TrieNode", is_array).
tabling_id_has_array_type(Id) = IsArray :-
tabling_id_base_type(Id, _, IsArray).
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.76
diff -u -b -r1.76 rtti_out.m
--- compiler/rtti_out.m 14 Nov 2007 04:24:50 -0000 1.76
+++ compiler/rtti_out.m 15 Nov 2007 02:15:02 -0000
@@ -1345,7 +1345,7 @@
:- type data_group
---> data_group(
data_c_type :: string,
- data_is_array :: bool,
+ data_is_array :: is_array,
data_linkage :: linkage
).
@@ -1414,7 +1414,7 @@
output_rtti_data_decl_chunk_entries(IsArray, RttiIds, !DeclSet, !IO).
-:- pred output_rtti_data_decl_chunk_entries(bool::in, list(rtti_id)::in,
+:- pred output_rtti_data_decl_chunk_entries(is_array::in, list(rtti_id)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_chunk_entries(_IsArray, [], !DeclSet, !IO) :-
@@ -1427,10 +1427,10 @@
io.write_string("\t", !IO),
output_rtti_id(RttiId, !IO),
(
- IsArray = yes,
+ IsArray = is_array,
io.write_string("[]", !IO)
;
- IsArray = no
+ IsArray = not_array
),
(
RttiIds = [_ | _],
@@ -1492,10 +1492,10 @@
io.write_string(" ", !IO),
output_rtti_id(RttiId, !IO),
(
- IsArray = yes,
+ IsArray = is_array,
io.write_string("[]", !IO)
;
- IsArray = no
+ IsArray = not_array
).
% Each type_info and pseudo_type_info may have a different C type,
@@ -1781,15 +1781,21 @@
:- pred output_addr_of_rtti_id(rtti_id::in, io::di, io::uo) is det.
output_addr_of_rtti_id(RttiId, !IO) :-
- % If the RttiName is not an array, then we need to use `&'
- % to take its address.
+ % All RttiIds are references to memory, with one exception: type variables.
( RttiId = ctor_rtti_id(_, type_ctor_pseudo_type_info(type_var(VarNum))) ->
io.write_int(VarNum, !IO)
- ; rtti_id_has_array_type(RttiId) = yes ->
+ ;
+ % If the RttiName is not an array, then we need to use `&'
+ % to take its address.
+ IsArray = rtti_id_has_array_type(RttiId),
+ (
+ IsArray = is_array,
output_rtti_id(RttiId, !IO)
;
+ IsArray = not_array,
io.write_string("&", !IO),
output_rtti_id(RttiId, !IO)
+ )
).
:- pred output_addr_of_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in,
@@ -1879,14 +1885,15 @@
:- pred rtti_id_linkage(rtti_id::in, linkage::out) is det.
rtti_id_linkage(RttiId, Linkage) :-
+ IsArray = rtti_id_has_array_type(RttiId),
(
+ IsArray = is_array,
% ANSI/ISO C doesn't allow forward declarations of static data
% with incomplete types (in this case array types without an explicit
% array size), so make the declarations extern.
- yes = rtti_id_has_array_type(RttiId)
- ->
Linkage = extern
;
+ IsArray = not_array,
Exported = rtti_id_is_exported(RttiId),
( Exported = yes, Linkage = extern
; Exported = no, Linkage = static
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.143
diff -u -b -r1.143 table_gen.m
--- compiler/table_gen.m 30 Dec 2007 08:23:58 -0000 1.143
+++ compiler/table_gen.m 30 Dec 2007 17:16:10 -0000
@@ -453,7 +453,9 @@
PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
VarSet0, VarSet, VarTypes0, VarTypes,
TableInfo0, TableInfo, CallTableTip, Goal, InputSteps),
- generate_gen_proc_table_info(TableInfo, PredId, ProcId, InputSteps, no,
+ MaybeOutputSteps = no,
+ generate_gen_proc_table_info(TableInfo, PredId, ProcId,
+ InputSteps, MaybeOutputSteps,
InputVarModeMethods, OutputVarModeMethods, ProcTableStructInfo),
MaybeCallTableTip = yes(CallTableTip),
MaybeProcTableIOInfo = no,
@@ -655,7 +657,7 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out) is det.
+ list(table_step_desc)::out) is det.
create_new_loop_goal(Detism, OrigGoal, Statistics, PredId, ProcId,
HeadVars, NumberedInputVars, NumberedOutputVars, !VarSet, !VarTypes,
@@ -896,7 +898,7 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out) is det.
+ list(table_step_desc)::out) is det.
create_new_memo_goal(Detism, OrigGoal, Statistics, _MaybeSizeLimit,
PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
@@ -1025,7 +1027,7 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out, list(table_trie_step)::out) is det.
+ list(table_step_desc)::out, list(table_step_desc)::out) is det.
create_new_memo_non_goal(Detism, OrigGoal, Statistics, _MaybeSizeLimit,
PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
@@ -1475,7 +1477,7 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out, list(table_trie_step)::out) is det.
+ list(table_step_desc)::out, list(table_step_desc)::out) is det.
create_new_mm_goal(Detism, OrigGoal, Statistics, PredId, ProcId,
HeadVars, NumberedInputVars, NumberedOutputVars, !VarSet, !VarTypes,
@@ -1593,7 +1595,7 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, generator_map::in, generator_map::out,
- hlds_goal::out, list(table_trie_step)::out, list(table_trie_step)::out)
+ hlds_goal::out, list(table_step_desc)::out, list(table_step_desc)::out)
is det.
do_own_stack_transform(Detism, OrigGoal, Statistics, PredId, ProcId,
@@ -1769,7 +1771,7 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
set(prog_var)::in, instmap_delta::in,
vartypes::in, prog_varset::in, table_info::in, table_info::out,
- list(table_trie_step)::in, list(table_trie_step)::out) is det.
+ list(table_step_desc)::in, list(table_step_desc)::out) is det.
do_own_stack_create_generator(PredId, ProcId, !.PredInfo, !.ProcInfo,
Statistics, Context, GeneratorVar, DebugArgStr, PickupVarCode,
@@ -1996,7 +1998,7 @@
%-----------------------------------------------------------------------------%
:- pred generate_gen_proc_table_info(table_info::in, pred_id::in, proc_id::in,
- list(table_trie_step)::in, maybe(list(table_trie_step))::in,
+ list(table_step_desc)::in, maybe(list(table_step_desc))::in,
list(var_mode_method)::in, list(var_mode_method)::in,
proc_table_struct_info::out) is det.
@@ -2034,7 +2036,7 @@
pred_id::in, proc_id::in, table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
- hlds_goal::out, list(table_trie_step)::out) is det.
+ hlds_goal::out, list(table_step_desc)::out) is det.
generate_simple_call_table_lookup_goal(StatusType, PredName,
SetupMacroName, NumberedVars, PredId, ProcId, Statistics, Context,
@@ -2084,7 +2086,7 @@
pred_id::in, proc_id::in, table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
- hlds_goal::out, list(table_trie_step)::out) is det.
+ hlds_goal::out, list(table_step_desc)::out) is det.
generate_memo_non_call_table_lookup_goal(NumberedVars, PredId, ProcId,
Statistics, Context, !VarSet, !VarTypes, !TableInfo,
@@ -2141,7 +2143,7 @@
pred_id::in, proc_id::in, table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
- hlds_goal::out, list(table_trie_step)::out) is det.
+ hlds_goal::out, list(table_step_desc)::out) is det.
generate_mm_call_table_lookup_goal(NumberedVars, PredId, ProcId,
Statistics, Context, !VarSet, !VarTypes, !TableInfo,
@@ -2197,7 +2199,7 @@
:- pred generate_call_table_lookup_goals(list(var_mode_pos_method)::in,
pred_id::in, proc_id::in, table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- table_info::in, table_info::out, list(table_trie_step)::out,
+ table_info::in, table_info::out, list(table_step_desc)::out,
prog_var::out, foreign_arg::out, foreign_arg::out, list(foreign_arg)::out,
list(hlds_goal)::out, string::out, string::out) is det.
@@ -2209,17 +2211,18 @@
"&" ++ proc_table_info_name ++ "->MR_pt_tablenode;\n",
generate_get_table_info_goal(PredId, ProcId, !VarSet, !VarTypes,
proc_table_info_name, InfoArg, GetTableInfoGoal),
+ MaybeStatsRef = stats_ref(Statistics, call_table),
DebugArgStr = get_debug_arg_string(!.TableInfo),
BackArgStr = get_back_arg_string(!.TableInfo),
- generate_table_lookup_goals(NumberedVars, Statistics, call_table,
+ generate_table_lookup_goals(NumberedVars, MaybeStatsRef,
DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
InputSteps, LookupArgs, LookupPrefixGoals, LookupCodeStr),
PrefixGoals = [GetTableInfoGoal] ++ LookupPrefixGoals,
% We ignore _StatsPrefixGoals and _StatsExtraArgs because we always
% include ProcTableInfoVar in the arguments.
- maybe_lookup_not_dupl_code_args(PredId, ProcId,
+ maybe_record_overall_stats(PredId, ProcId,
proc_table_info_name, cur_table_node_name,
- Statistics, call_table, !VarSet, !VarTypes,
+ MaybeStatsRef, !VarSet, !VarTypes,
_StatsPrefixGoals, _StatsExtraArgs, StatsCodeStr),
MainCodeStr = InfoToPtrCodeStr ++ LookupCodeStr ++ StatsCodeStr,
CallTableTipVarName = "CallTableTipVar",
@@ -2234,60 +2237,52 @@
:- pred generate_answer_table_lookup_goals(list(var_mode_pos_method)::in,
pred_id::in, proc_id::in, table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- table_info::in, table_info::out, list(table_trie_step)::out,
+ table_info::in, table_info::out, list(table_step_desc)::out,
list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
generate_answer_table_lookup_goals(NumberedVars, PredId, ProcId, Statistics,
Context, !VarSet, !VarTypes, !TableInfo, OutputSteps, ForeignArgs,
PrefixGoals, CodeStr) :-
+ MaybeStatsRef = stats_ref(Statistics, answer_table),
DebugArgStr = get_debug_arg_string(!.TableInfo),
BackArgStr = "MR_FALSE",
- generate_table_lookup_goals(NumberedVars, Statistics, answer_table,
+ generate_table_lookup_goals(NumberedVars, MaybeStatsRef,
DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
OutputSteps, LookupArgs, LookupPrefixGoals, LookupCodeStr),
- maybe_lookup_not_dupl_code_args(PredId, ProcId,
+ maybe_record_overall_stats(PredId, ProcId,
proc_table_info_name, cur_table_node_name,
- Statistics, call_table, !VarSet, !VarTypes,
+ MaybeStatsRef, !VarSet, !VarTypes,
StatsPrefixGoals, StatsExtraArgs, StatsCodeStr),
CodeStr = LookupCodeStr ++ StatsCodeStr,
ForeignArgs = StatsExtraArgs ++ LookupArgs,
PrefixGoals = StatsPrefixGoals ++ LookupPrefixGoals.
-:- pred maybe_lookup_not_dupl_code_args(pred_id::in, proc_id::in,
- string::in, string::in, table_attr_statistics::in,
- call_or_answer_table::in,
+:- pred maybe_record_overall_stats(pred_id::in, proc_id::in,
+ string::in, string::in, maybe(string)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
list(hlds_goal)::out, list(foreign_arg)::out, string::out) is det.
-maybe_lookup_not_dupl_code_args(PredId, ProcId, InfoVarName, TipVarName,
- Statistics, Kind, !VarSet, !VarTypes, PrefixGoals, Args, CodeStr) :-
+maybe_record_overall_stats(PredId, ProcId, InfoVarName, TipVarName,
+ MaybeStatsRef, !VarSet, !VarTypes, PrefixGoals, Args, StatsCodeStr) :-
(
- Statistics = table_dont_gather_statistics,
+ MaybeStatsRef = no,
PrefixGoals = [],
Args = [],
- CodeStr = ""
+ StatsCodeStr = ""
;
- Statistics = table_gather_statistics,
+ MaybeStatsRef = yes(StatsRef),
generate_get_table_info_goal(PredId, ProcId, !VarSet, !VarTypes,
InfoVarName, Arg, Goal),
PrefixGoals = [Goal],
Args = [Arg],
- CodeStr = lookup_not_dupl_code(InfoVarName, TipVarName, Kind)
+ StatsCodeStr =
+ "\t" ++ StatsRef ++ ".MR_ts_num_lookups++;\n" ++
+ "\t" ++ "if (MR_trie_node_seen_before(" ++ TipVarName ++ ")) " ++
+ "{\n" ++
+ "\t\t" ++ StatsRef ++ ".MR_ts_num_lookups_is_dupl++;\n" ++
+ "\t" ++ "}\n"
).
-:- func lookup_not_dupl_code(string, string, call_or_answer_table) = string.
-
-lookup_not_dupl_code(InfoVar, TipVar, call_table) =
- "\t" ++ InfoVar ++ "->MR_pt_call_table_lookups++;\n" ++
- "\tif (" ++ TipVar ++ "->MR_integer != 0) {\n" ++
- "\t\t" ++ InfoVar ++ "->MR_pt_call_table_not_dupl++;\n" ++
- "\t}\n".
-lookup_not_dupl_code(InfoVar, TipVar, answer_table) =
- "\t" ++ InfoVar ++ "->MR_pt_answer_table_lookups++;\n" ++
- "\tif (" ++ TipVar ++ "->MR_integer != 0) {\n" ++
- "\t\t" ++ InfoVar ++ "->MR_pt_answer_table_not_dupl++;\n" ++
- "\t}\n".
-
:- pred generate_get_table_info_goal(pred_id::in, proc_id::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
string::in, foreign_arg::out, hlds_goal::out) is det.
@@ -2321,19 +2316,19 @@
% and answer tables.
%
:- pred generate_table_lookup_goals(list(var_mode_pos_method)::in,
- table_attr_statistics::in, call_or_answer_table::in,
- string::in, string::in, term.context::in,
+ maybe(string)::in, string::in, string::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- table_info::in, table_info::out, list(table_trie_step)::out,
+ table_info::in, table_info::out, list(table_step_desc)::out,
list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-generate_table_lookup_goals([], _, _, _, _, _, !VarSet, !VarTypes, !TableInfo,
+generate_table_lookup_goals([], _, _, _, _, !VarSet, !VarTypes, !TableInfo,
[], [], [], "").
-generate_table_lookup_goals([VarModePos | NumberedVars], Statistics,
- Kind, DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
- [Step | Steps], ForeignArgs ++ RestForeignArgs,
+generate_table_lookup_goals([VarModePos | NumberedVars], MaybeStatsRef,
+ DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
+ [StepDesc | StepDescs], ForeignArgs ++ RestForeignArgs,
PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
VarModePos = var_mode_pos_method(Var, _, VarSeqNum, ArgMethod),
+ varset.lookup_name(!.VarSet, Var, VarName),
ModuleInfo = !.TableInfo ^ table_module_info,
map.lookup(!.VarTypes, Var, VarType),
classify_type(ModuleInfo, VarType) = TypeCat,
@@ -2348,30 +2343,62 @@
; ArgMethod = arg_addr
),
gen_lookup_call_for_type(ArgMethod, TypeCat, VarType, Var,
- VarSeqNum, Statistics, Kind, DebugArgStr, BackArgStr, Context,
+ VarSeqNum, MaybeStatsRef, DebugArgStr, BackArgStr, Context,
!VarSet, !VarTypes, !TableInfo, Step, ForeignArgs,
PrefixGoals, CodeStr)
),
- generate_table_lookup_goals(NumberedVars, Statistics, Kind,
+ StepDesc = table_step_desc(VarName, Step),
+ generate_table_lookup_goals(NumberedVars, MaybeStatsRef,
DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
- Steps, RestForeignArgs, RestPrefixGoals, RestCodeStr).
+ StepDescs, RestForeignArgs, RestPrefixGoals, RestCodeStr).
:- pred gen_lookup_call_for_type(arg_tabling_method::in, type_category::in,
- mer_type::in, prog_var::in, int::in, table_attr_statistics::in,
- call_or_answer_table::in, string::in, string::in, term.context::in,
+ mer_type::in, prog_var::in, int::in, maybe(string)::in,
+ string::in, string::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out,
table_trie_step::out, list(foreign_arg)::out, list(hlds_goal)::out,
string::out) is det.
-gen_lookup_call_for_type(ArgTablingMethod, TypeCat, Type, ArgVar, VarSeqNum,
- Statistics, Kind, DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes,
+gen_lookup_call_for_type(ArgTablingMethod0, TypeCat, Type, ArgVar, VarSeqNum,
+ MaybeStatsRef, DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes,
!TableInfo, Step, ExtraArgs, PrefixGoals, CodeStr) :-
ModuleInfo = !.TableInfo ^ table_module_info,
ArgName = arg_name(VarSeqNum),
ForeignArg = foreign_arg(ArgVar, yes(ArgName - in_mode), Type,
native_if_possible),
(
+ ( TypeCat = type_cat_enum
+ ; TypeCat = type_cat_foreign_enum
+ ; TypeCat = type_cat_int
+ ; TypeCat = type_cat_char
+ ; TypeCat = type_cat_void
+ ),
+ % Values in these type categories don't have an address.
+ ( ArgTablingMethod0 = arg_addr ->
+ ArgTablingMethod = arg_value
+ ;
+ ArgTablingMethod = ArgTablingMethod0
+ )
+ ;
+ ( TypeCat = type_cat_string
+ ; TypeCat = type_cat_float
+ ; TypeCat = type_cat_type_info
+ ; TypeCat = type_cat_type_ctor_info
+ ; TypeCat = type_cat_higher_order
+ ; TypeCat = type_cat_tuple
+ ; TypeCat = type_cat_variable
+ ; TypeCat = type_cat_user_ctor
+ ; TypeCat = type_cat_dummy
+ ; TypeCat = type_cat_typeclass_info
+ ; TypeCat = type_cat_base_typeclass_info
+ ),
+ ArgTablingMethod = ArgTablingMethod0
+ ),
+ MaybeStepStatsArgStr = maybe_step_stats_arg_addr(MaybeStatsRef, VarSeqNum),
+ (
+ ArgTablingMethod = arg_value,
+ (
TypeCat = type_cat_enum,
type_to_ctor_det(Type, TypeCtor),
module_info_get_type_table(ModuleInfo, TypeDefnTable),
@@ -2391,16 +2418,21 @@
Step = table_trie_step_enum(EnumRange),
PrefixGoals = [],
ExtraArgs = [ForeignArg],
- StatsArgStr = stats_arg(Statistics, Kind, VarSeqNum),
- CodeStr0 = "\t" ++ LookupMacroName ++ "(" ++ StatsArgStr ++ ", " ++
- DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
- cur_table_node_name ++ ", " ++ int_to_string(EnumRange) ++
- ", " ++ ArgName ++ ", " ++ next_table_node_name ++ ");\n"
+ LookupCodeStr = "\t" ++ LookupMacroName ++ "(" ++
+ MaybeStepStatsArgStr ++ ", " ++ DebugArgStr ++ ", " ++
+ BackArgStr ++ ", " ++ cur_table_node_name ++ ", " ++
+ int_to_string(EnumRange) ++ ", " ++ ArgName ++ ", " ++
+ next_table_node_name ++ ");\n"
;
+ (
+ % Mercury doesn't know the specific values of the foreign
+ % enums, so we cannot use an array as a trie (since we don't
+ % know how big the array would have to be). However, hashing
+ % the enum as an int will work.
TypeCat = type_cat_foreign_enum,
- sorry(this_file, "tabling and foreign enumerations NYI.")
+ CatString = "int",
+ Step = table_trie_step_int
;
- (
TypeCat = type_cat_int,
CatString = "int",
Step = table_trie_step_int
@@ -2428,43 +2460,114 @@
LookupMacroName = "MR_tbl_lookup_insert_" ++ CatString,
PrefixGoals = [],
ExtraArgs = [ForeignArg],
- StatsArgStr = stats_arg(Statistics, Kind, VarSeqNum),
- CodeStr0 = "\t" ++ LookupMacroName ++ "(" ++ StatsArgStr ++ ", " ++
- DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
- cur_table_node_name ++ ", " ++ ArgName ++ ", " ++
- next_table_node_name ++ ");\n"
- ;
- (
- TypeCat = type_cat_higher_order
+ LookupCodeStr = "\t" ++ LookupMacroName ++ "(" ++
+ MaybeStepStatsArgStr ++ ", " ++ DebugArgStr ++ ", " ++
+ BackArgStr ++ ", " ++ cur_table_node_name ++ ", " ++
+ ArgName ++ ", " ++ next_table_node_name ++ ");\n"
;
- TypeCat = type_cat_tuple
+ ( TypeCat = type_cat_higher_order
+ ; TypeCat = type_cat_tuple
+ ; TypeCat = type_cat_variable
+ ; TypeCat = type_cat_user_ctor
+ ),
+ MaybeAddrString = "",
+ IsAddr = table_value,
+ gen_general_lookup_call(IsAddr, MaybeAddrString, Type, ForeignArg,
+ ArgName, VarSeqNum, MaybeStatsRef, DebugArgStr, BackArgStr,
+ Context, !VarSet, !VarTypes, !TableInfo, Step, ExtraArgs,
+ PrefixGoals, LookupCodeStr)
;
- TypeCat = type_cat_variable
+ TypeCat = type_cat_dummy,
+ Step = table_trie_step_dummy,
+ PrefixGoals = [],
+ ExtraArgs = [],
+ LookupCodeStr = "\t" ++ next_table_node_name ++ " = " ++
+ cur_table_node_name ++ ";\n"
;
- TypeCat = type_cat_user_ctor
+ TypeCat = type_cat_void,
+ unexpected(this_file, "gen_lookup_call_for_type: void")
;
TypeCat = type_cat_typeclass_info,
- (
- ArgTablingMethod = arg_value,
unexpected(this_file,
"gen_lookup_call_for_type: typeclass_info_type")
;
- ( ArgTablingMethod = arg_addr
- ; ArgTablingMethod = arg_promise_implied
- )
- )
- ;
TypeCat = type_cat_base_typeclass_info,
- (
- ArgTablingMethod = arg_value,
unexpected(this_file,
"gen_lookup_call_for_type: base_typeclass_info_type")
- ;
- ( ArgTablingMethod = arg_addr
- ; ArgTablingMethod = arg_promise_implied
)
+ ;
+ ArgTablingMethod = arg_addr,
+ (
+ TypeCat = type_cat_enum,
+ unexpected(this_file, "tabling enums by addr")
+ ;
+ TypeCat = type_cat_foreign_enum,
+ unexpected(this_file, "tabling foreign enums by addr")
+ ;
+ TypeCat = type_cat_int,
+ unexpected(this_file, "tabling ints by addr")
+ ;
+ TypeCat = type_cat_char,
+ unexpected(this_file, "tabling chars by addr")
+ ;
+ ( TypeCat = type_cat_string
+ ; TypeCat = type_cat_float
+ ; TypeCat = type_cat_type_info
+ ; TypeCat = type_cat_type_ctor_info
+ ; TypeCat = type_cat_typeclass_info
+ ; TypeCat = type_cat_base_typeclass_info
+ ; TypeCat = type_cat_higher_order
+ ; TypeCat = type_cat_tuple
+ ; TypeCat = type_cat_variable
+ ; TypeCat = type_cat_user_ctor
+ ),
+ MaybeAddrString = "_addr",
+ IsAddr = table_addr,
+ gen_general_lookup_call(IsAddr, MaybeAddrString, Type, ForeignArg,
+ ArgName, VarSeqNum, MaybeStatsRef, DebugArgStr, BackArgStr,
+ Context, !VarSet, !VarTypes, !TableInfo, Step, ExtraArgs,
+ PrefixGoals, LookupCodeStr)
+ ;
+ TypeCat = type_cat_dummy,
+ unexpected(this_file, "tabling dummies by addr")
+ ;
+ TypeCat = type_cat_void,
+ unexpected(this_file, "gen_lookup_call_for_type: void")
)
+ ;
+ ArgTablingMethod = arg_promise_implied,
+ unexpected(this_file, "gen_lookup_call_for_type: arg_promise_implied")
),
+ UpdateCurNodeCodeStr = "\t" ++ cur_table_node_name ++ " = " ++
+ next_table_node_name ++ ";\n",
+ (
+ MaybeStatsRef = no,
+ CodeStr = LookupCodeStr ++ UpdateCurNodeCodeStr
+ ;
+ MaybeStatsRef = yes(StatsRef),
+ StepStatsArgStr = step_stats_arg_addr(StatsRef, VarSeqNum),
+ NextVarName = next_table_node_name,
+ LookupStatsCodeStr =
+ "\t" ++ StepStatsArgStr ++ ".MR_tss_num_lookups++;\n" ++
+ "\t" ++ "if (MR_trie_node_seen_before(" ++ NextVarName ++ "))" ++
+ "{\n" ++
+ "\t\t" ++ StepStatsArgStr ++ ".MR_tss_num_lookups_is_dupl++;\n" ++
+ "\t" ++ "}\n",
+ CodeStr = LookupCodeStr ++ LookupStatsCodeStr ++ UpdateCurNodeCodeStr
+ ).
+
+:- pred gen_general_lookup_call(table_value_or_addr::in, string::in,
+ mer_type::in, foreign_arg::in, string::in, int::in, maybe(string)::in,
+ string::in, string::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out,
+ table_trie_step::out, list(foreign_arg)::out, list(hlds_goal)::out,
+ string::out) is det.
+
+gen_general_lookup_call(IsAddr, MaybeAddrString, Type, ForeignArg, ArgName,
+ VarSeqNum, MaybeStatsRef, DebugArgStr, BackArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, Step, ExtraArgs, PrefixGoals,
+ LookupCodeStr) :-
type_vars(Type, TypeVars),
(
TypeVars = [],
@@ -2475,19 +2578,6 @@
MaybePolyString = "_poly",
IsPoly = table_is_poly
),
- (
- ArgTablingMethod = arg_value,
- MaybeAddrString = "",
- IsAddr = table_value
- ;
- ArgTablingMethod = arg_addr,
- MaybeAddrString = "_addr",
- IsAddr = table_addr
- ;
- ArgTablingMethod = arg_promise_implied,
- unexpected(this_file,
- "gen_lookup_call_for_type: arg_promise_implied")
- ),
Step = table_trie_step_general(Type, IsPoly, IsAddr),
LookupMacroName = "MR_tbl_lookup_insert_gen" ++
MaybePolyString ++ MaybeAddrString,
@@ -2496,26 +2586,14 @@
TypeInfoArgName = "input_typeinfo" ++ int_to_string(VarSeqNum),
map.lookup(!.VarTypes, TypeInfoVar, TypeInfoType),
ForeignTypeInfoArg = foreign_arg(TypeInfoVar,
- yes(TypeInfoArgName - in_mode), TypeInfoType, native_if_possible),
+ yes(TypeInfoArgName - in_mode), TypeInfoType,
+ native_if_possible),
ExtraArgs = [ForeignTypeInfoArg, ForeignArg],
- StatsArgStr = stats_arg(Statistics, Kind, VarSeqNum),
- CodeStr0 = "\t" ++ LookupMacroName ++ "(" ++ StatsArgStr ++ ", " ++
- DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
+ StepStatsArgStr = maybe_step_stats_arg_addr(MaybeStatsRef, VarSeqNum),
+ LookupCodeStr = "\t" ++ LookupMacroName ++ "(" ++
+ StepStatsArgStr ++ ", " ++ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ TypeInfoArgName ++ ", " ++
- ArgName ++ ", " ++ next_table_node_name ++ ");\n"
- ;
- TypeCat = type_cat_dummy,
- Step = table_trie_step_dummy,
- PrefixGoals = [],
- ExtraArgs = [],
- CodeStr0 = "\t" ++ next_table_node_name ++ " = " ++
- cur_table_node_name ++ ";\n"
- ;
- TypeCat = type_cat_void,
- unexpected(this_file, "gen_lookup_call_for_type: void")
- ),
- CodeStr = CodeStr0 ++ "\t" ++ cur_table_node_name ++ " = " ++
- next_table_node_name ++ ";\n".
+ ArgName ++ ", " ++ next_table_node_name ++ ");\n".
%-----------------------------------------------------------------------------%
@@ -2564,7 +2642,7 @@
pred_id::in, proc_id::in, prog_var::in, int::in,
table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- table_info::in, table_info::out, list(table_trie_step)::out,
+ table_info::in, table_info::out, list(table_step_desc)::out,
list(hlds_goal)::out) is det.
generate_memo_non_save_goals(NumberedSaveVars, PredId, ProcId,
@@ -2620,7 +2698,7 @@
prog_var::in, pred_id::in, proc_id::in, int::in,
table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- table_info::in, table_info::out, list(table_trie_step)::out,
+ table_info::in, table_info::out, list(table_step_desc)::out,
list(hlds_goal)::out) is det.
generate_mm_save_goals(NumberedSaveVars, SubgoalVar, PredId, ProcId, BlockSize,
@@ -2698,7 +2776,7 @@
prog_var::in, pred_id::in, proc_id::in, int::in,
table_attr_statistics::in, term.context::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- table_info::in, table_info::out, list(table_trie_step)::out,
+ table_info::in, table_info::out, list(table_step_desc)::out,
list(hlds_goal)::out) is det.
generate_own_stack_save_return_goal(NumberedOutputVars, GeneratorVar,
@@ -3340,8 +3418,7 @@
MaybeTableAttributes = no,
TableAttributes = default_memo_table_attributes
),
- TableStructInfo = table_struct_info(ProcTableStructInfo,
- TableAttributes),
+ TableStructInfo = table_struct_info(ProcTableStructInfo, TableAttributes),
map.det_insert(TableStructMap0, PredProcId, TableStructInfo,
TableStructMap),
module_info_set_table_struct_map(TableStructMap, !ModuleInfo).
@@ -3573,25 +3650,42 @@
---> call_table
; answer_table.
-:- func stats_arg(table_attr_statistics, call_or_answer_table, int) = string.
+:- func stats_ref(table_attr_statistics, call_or_answer_table) = maybe(string).
-stats_arg(Statistics, Kind, SeqNum) = ArgStr :-
+stats_ref(Statistics, Kind) = MaybeStatsRef :-
(
Statistics = table_dont_gather_statistics,
- ArgStr = "NULL"
+ MaybeStatsRef = no
;
Statistics = table_gather_statistics,
(
Kind = call_table,
- ArgStr = "&" ++ proc_table_info_name ++
- "->MR_pt_call_table_stats[" ++ int_to_string(SeqNum) ++ "]"
+ KindStr = "MR_TABLE_CALL_TABLE"
;
Kind = answer_table,
- ArgStr = "&" ++ proc_table_info_name ++
- "->MR_pt_answer_table_stats[" ++ int_to_string(SeqNum) ++ "]"
- )
+ KindStr = "MR_TABLE_ANSWER_TABLE"
+ ),
+ StatsRef = proc_table_info_name ++ "->MR_pt_stats" ++
+ "[" ++ KindStr ++ "][MR_TABLE_STATS_CURR]",
+ MaybeStatsRef = yes(StatsRef)
).
+:- func maybe_step_stats_arg_addr(maybe(string), int) = string.
+
+maybe_step_stats_arg_addr(MaybeStatsRef, SeqNum) = ArgStr :-
+ (
+ MaybeStatsRef = no,
+ ArgStr = "NULL"
+ ;
+ MaybeStatsRef = yes(StatsRef),
+ ArgStr = "&(" ++ step_stats_arg_addr(StatsRef, SeqNum) ++ ")"
+ ).
+
+:- func step_stats_arg_addr(string, int) = string.
+
+step_stats_arg_addr(StatsRef, SeqNum) = ArgStr :-
+ ArgStr = StatsRef ++ ".MR_ts_steps" ++ "[" ++ int_to_string(SeqNum) ++ "]".
+
%-----------------------------------------------------------------------------%
:- pred table_gen_make_type_info_var(mer_type::in, term.context::in,
@@ -3606,8 +3700,7 @@
( TypeInfoVars = [TypeInfoVar0] ->
TypeInfoVar = TypeInfoVar0
;
- unexpected(this_file,
- "table_gen_make_type_info_var: list length != 1")
+ unexpected(this_file, "table_gen_make_type_info_var: list length != 1")
).
:- pred table_gen_make_type_info_vars(list(mer_type)::in, term.context::in,
@@ -3615,8 +3708,8 @@
table_info::in, table_info::out, list(prog_var)::out,
list(hlds_goal)::out) is det.
-table_gen_make_type_info_vars(Types, Context, !VarSet, !VarTypes, !TableInfo,
- TypeInfoVars, TypeInfoGoals) :-
+table_gen_make_type_info_vars(Types, Context, !VarSet, !VarTypes,
+ !TableInfo, TypeInfoVars, TypeInfoGoals) :-
% Extract the information from table_info.
table_info_extract(!.TableInfo, ModuleInfo0, PredInfo0, ProcInfo0),
@@ -3636,8 +3729,7 @@
proc_info_get_vartypes(ProcInfo, !:VarTypes),
proc_info_get_varset(ProcInfo, !:VarSet),
- % Put the new module_info, pred_info, and proc_info back in the
- % table_info.
+ % Put the new module_info, pred_info, and proc_info back in the table_info.
table_info_init(ModuleInfo, PredInfo, ProcInfo, !:TableInfo).
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.117
diff -u -b -r1.117 library.m
--- library/library.m 10 Sep 2007 16:32:24 -0000 1.117
+++ library/library.m 5 Nov 2007 03:24:27 -0000
@@ -125,6 +125,7 @@
:- import_module svrelation.
:- import_module svset.
:- import_module svvarset.
+:- import_module table_statistics.
:- import_module term.
:- import_module term_io.
:- import_module term_to_xml.
@@ -304,6 +305,7 @@
mercury_std_library_module("svset").
mercury_std_library_module("svvarset").
mercury_std_library_module("table_builtin").
+mercury_std_library_module("table_statistics").
mercury_std_library_module("term").
mercury_std_library_module("term_io").
mercury_std_library_module("term_size_prof_builtin").
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.62
diff -u -b -r1.62 table_builtin.m
--- library/table_builtin.m 15 Aug 2007 01:35:01 -0000 1.62
+++ library/table_builtin.m 29 Aug 2007 06:53:13 -0000
@@ -31,9 +31,6 @@
:- module table_builtin.
:- interface.
-:- import_module maybe.
-:- import_module list.
-
% This section of the module contains the predicates that are
% automatically inserted by the table_gen pass of the compiler
% into predicates that use tabling, and the types they use.
@@ -118,64 +115,6 @@
%
:- type ml_proc_table_info.
-:- type proc_table_statistics
- ---> proc_table_statistics(
- call_table_stats :: table_stats_pair,
- maybe_answer_table_stats :: maybe(table_stats_pair)
- ).
-
-:- type table_stats_pair
- ---> table_stats_pair(
- overall_stats :: table_stats,
- stats_since_last :: table_stats
- ).
-
-:- type table_stats
- ---> table_stats(
- num_lookups :: int,
- num_lookups_not_duplicate :: int,
- step_statistics :: list(table_step_stats)
- ).
-
- % The definition of this type should be kept in sync with the type
- % table_trie_step in hlds_pred.m.
- % MR_TableTrieStep in runtime/mercury_tabling.h.
-:- type table_step_kind
- ---> table_step_dummy
- ; table_step_int
- ; table_step_char
- ; table_step_string
- ; table_step_float
- ; table_step_enum
- ; table_step_general(
- table_is_poly,
- table_value_or_addr
- )
- ; table_step_typeinfo
- ; table_step_typeclassinfo
- ; table_step_promise_implied.
-
-:- type table_is_poly
- ---> table_is_poly % The table type is polymorphic.
- ; table_is_mono. % The table type is monomorphic.
-
-:- type table_value_or_addr
- ---> table_value % We are tabling the value itself.
- ; table_addr. % We are tabling only the address.
-
-:- type table_step_stats
- ---> table_step_stats(
- table_step_kind :: table_step_kind,
- step_num_allocs :: int,
- step_num_inserts :: int,
- step_num_lookups :: int,
- step_num_insert_probes :: int,
- step_num_lookup_probes :: int,
- step_num_resizes :: int,
- step_num_resizes_old_entries :: int,
- step_num_resizes_new_entries :: int
- ).
-
% N.B. interface continued below
%-----------------------------------------------------------------------------%
@@ -206,252 +145,6 @@
:- pragma foreign_type(il, ml_proc_table_info,
"class [mscorlib]System.Object").
-:- pred get_tabling_stats(ml_proc_table_info::in, proc_table_statistics::out,
- io::di, io::uo) is det.
-:- pragma foreign_export("C", get_tabling_stats(in, out, di, uo),
- "MR_get_tabling_stats").
-:- pragma foreign_export("IL", get_tabling_stats(in, out, di, uo),
- "MR_get_tabling_stats").
-
-get_tabling_stats(Info, Statistics, !IO) :-
- get_direct_fields(Info, AnswerTable, NumInputs, NumOutputs,
- CallTableLookups, CallTableNotDupl,
- PrevCallTableLookups, PrevCallTableNotDupl,
- AnswerTableLookups, AnswerTableNotDupl,
- PrevAnswerTableLookups, PrevAnswerTableNotDupl, !IO),
- get_all_input_step_stats(Info, NumInputs - 1,
- [], CurCallTableStepStats, [], PrevCallTableStepStats, !IO),
- CurCallTableStats = table_stats(CallTableLookups,
- CallTableNotDupl, CurCallTableStepStats),
- PrevCallTableStats = table_stats(PrevCallTableLookups,
- PrevCallTableNotDupl, PrevCallTableStepStats),
- CallTableStats = table_stats_pair(CurCallTableStats, PrevCallTableStats),
- ( AnswerTable > 0 ->
- get_all_output_step_stats(Info, NumOutputs - 1,
- [], CurAnswerTableStepStats, [], PrevAnswerTableStepStats, !IO),
- CurAnswerTableStats = table_stats(AnswerTableLookups,
- AnswerTableNotDupl, CurAnswerTableStepStats),
- PrevAnswerTableStats = table_stats(PrevAnswerTableLookups,
- PrevAnswerTableNotDupl, PrevAnswerTableStepStats),
- AnswerTableStats = table_stats_pair(CurAnswerTableStats,
- PrevAnswerTableStats),
- MaybeAnswerTableStats = yes(AnswerTableStats)
- ;
- MaybeAnswerTableStats = no
- ),
- Statistics = proc_table_statistics(CallTableStats, MaybeAnswerTableStats),
- copy_current_stats_to_prev(Info, !IO).
-
-:- pred get_direct_fields(ml_proc_table_info::in, int::out, int::out, int::out,
- int::out, int::out, int::out, int::out,
- int::out, int::out, int::out, int::out,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
- get_direct_fields(Info::in, AnswerTable::out, Inputs::out, Outputs::out,
- CallTableLookups::out, CallTableNotDupl::out,
- PrevCallTableLookups::out, PrevCallTableNotDupl::out,
- AnswerTableLookups::out, AnswerTableNotDupl::out,
- PrevAnswerTableLookups::out, PrevAnswerTableNotDupl::out,
- _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, does_not_affect_liveness],
-"
- AnswerTable = ( Info->MR_pt_has_answer_table ? 1 : 0 );
- Inputs = Info->MR_pt_num_inputs;
- Outputs = Info->MR_pt_num_outputs;
- CallTableLookups = Info->MR_pt_call_table_lookups;
- PrevCallTableLookups = Info->MR_pt_prev_call_table_lookups;
- CallTableNotDupl = Info->MR_pt_call_table_not_dupl;
- PrevCallTableNotDupl = Info->MR_pt_prev_call_table_not_dupl;
- AnswerTableLookups = Info->MR_pt_answer_table_lookups;
- PrevAnswerTableLookups = Info->MR_pt_prev_answer_table_lookups;
- AnswerTableNotDupl = Info->MR_pt_answer_table_not_dupl;
- PrevAnswerTableNotDupl = Info->MR_pt_prev_answer_table_not_dupl;
-").
-
-:- pred get_all_input_step_stats(ml_proc_table_info::in, int::in,
- list(table_step_stats)::in, list(table_step_stats)::out,
- list(table_step_stats)::in, list(table_step_stats)::out,
- io::di, io::uo) is det.
-
-get_all_input_step_stats(Info, CurSlot, !CurStepStats, !PrevStepStats, !IO) :-
- ( CurSlot < 0 ->
- true
- ;
- get_input_step_stats(Info, CurSlot, Kind,
- NumAllocs, NumInserts, NumLookups,
- NumInsertProbes, NumLookupProbes,
- NumResizes, NumResizesOld, NumResizesNew,
- PrevNumAllocs, PrevNumInserts, PrevNumLookups,
- PrevNumInsertProbes, PrevNumLookupProbes,
- PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew, !IO),
- Cur = table_step_stats(Kind, NumAllocs,
- NumInserts, NumLookups,
- NumInsertProbes, NumLookupProbes,
- NumResizes, NumResizesOld, NumResizesNew),
- Prev = table_step_stats(Kind, PrevNumAllocs,
- PrevNumInserts, PrevNumLookups,
- PrevNumInsertProbes, PrevNumLookupProbes,
- PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew),
- !:CurStepStats = [Cur | !.CurStepStats],
- !:PrevStepStats = [Prev | !.PrevStepStats],
- get_all_input_step_stats(Info, CurSlot - 1,
- !CurStepStats, !PrevStepStats, !IO)
- ).
-
-:- pred get_all_output_step_stats(ml_proc_table_info::in, int::in,
- list(table_step_stats)::in, list(table_step_stats)::out,
- list(table_step_stats)::in, list(table_step_stats)::out,
- io::di, io::uo) is det.
-
-get_all_output_step_stats(Info, CurSlot, !CurStepStats, !PrevStepStats, !IO) :-
- ( CurSlot < 0 ->
- true
- ;
- get_output_step_stats(Info, CurSlot, Kind,
- NumAllocs, NumInserts, NumLookups,
- NumInsertProbes, NumLookupProbes,
- NumResizes, NumResizesOld, NumResizesNew,
- PrevNumAllocs, PrevNumInserts, PrevNumLookups,
- PrevNumInsertProbes, PrevNumLookupProbes,
- PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew, !IO),
- Cur = table_step_stats(Kind, NumAllocs,
- NumInserts, NumLookups,
- NumInsertProbes, NumLookupProbes,
- NumResizes, NumResizesOld, NumResizesNew),
- Prev = table_step_stats(Kind, PrevNumAllocs,
- PrevNumInserts, PrevNumLookups,
- PrevNumInsertProbes, PrevNumLookupProbes,
- PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew),
- !:CurStepStats = [Cur | !.CurStepStats],
- !:PrevStepStats = [Prev | !.PrevStepStats],
- get_all_output_step_stats(Info, CurSlot - 1,
- !CurStepStats, !PrevStepStats, !IO)
- ).
-
-:- pred get_input_step_stats(ml_proc_table_info::in, int::in,
- table_step_kind::out,
- int::out, int::out, int::out, int::out, int::out,
- int::out, int::out, int::out,
- int::out, int::out, int::out, int::out, int::out,
- int::out, int::out, int::out,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
- get_input_step_stats(Info::in, ArgNum::in, Kind::out,
- NumAllocs::out, NumInserts::out, NumLookups::out,
- NumInsertProbes::out, NumLookupProbes::out,
- NumResizes::out, NumResizesOld::out, NumResizesNew::out,
- PrevNumAllocs::out, PrevNumInserts::out, PrevNumLookups::out,
- PrevNumInsertProbes::out, PrevNumLookupProbes::out,
- PrevNumResizes::out, PrevNumResizesOld::out, PrevNumResizesNew::out,
- _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, does_not_affect_liveness],
-"
- MR_TableStepStats *cur;
- MR_TableStepStats *prev;
-
- Kind = Info->MR_pt_input_steps[ArgNum];
-
- cur = &Info->MR_pt_call_table_stats[ArgNum];
- prev = &Info->MR_pt_prev_call_table_stats[ArgNum];
-
- NumAllocs = cur->MR_tss_num_allocs;
- NumInserts = cur->MR_tss_num_inserts;
- NumLookups = cur->MR_tss_num_lookups;
- NumInsertProbes = cur->MR_tss_num_insert_probes;
- NumLookupProbes = cur->MR_tss_num_lookup_probes;
- NumResizes = cur->MR_tss_num_resizes;
- NumResizesOld = cur->MR_tss_num_resizes_old_entries;
- NumResizesNew = cur->MR_tss_num_resizes_new_entries;
-
- PrevNumAllocs = prev->MR_tss_num_allocs;
- PrevNumInserts = prev->MR_tss_num_inserts;
- PrevNumLookups = prev->MR_tss_num_lookups;
- PrevNumInsertProbes = prev->MR_tss_num_insert_probes;
- PrevNumLookupProbes = prev->MR_tss_num_lookup_probes;
- PrevNumResizes = prev->MR_tss_num_resizes;
- PrevNumResizesOld = prev->MR_tss_num_resizes_old_entries;
- PrevNumResizesNew = prev->MR_tss_num_resizes_new_entries;
-").
-
-:- pred get_output_step_stats(ml_proc_table_info::in, int::in,
- table_step_kind::out,
- int::out, int::out, int::out, int::out, int::out,
- int::out, int::out, int::out,
- int::out, int::out, int::out, int::out, int::out,
- int::out, int::out, int::out,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
- get_output_step_stats(Info::in, ArgNum::in, Kind::out,
- NumAllocs::out, NumInserts::out, NumLookups::out,
- NumInsertProbes::out, NumLookupProbes::out,
- NumResizes::out, NumResizesOld::out, NumResizesNew::out,
- PrevNumAllocs::out, PrevNumInserts::out, PrevNumLookups::out,
- PrevNumInsertProbes::out, PrevNumLookupProbes::out,
- PrevNumResizes::out, PrevNumResizesOld::out, PrevNumResizesNew::out,
- _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, does_not_affect_liveness],
-"
- MR_TableStepStats *cur;
- MR_TableStepStats *prev;
-
- Kind = Info->MR_pt_output_steps[ArgNum];
-
- cur = &Info->MR_pt_answer_table_stats[ArgNum];
- prev = &Info->MR_pt_prev_answer_table_stats[ArgNum];
-
- NumAllocs = cur->MR_tss_num_allocs;
- NumInserts = cur->MR_tss_num_inserts;
- NumLookups = cur->MR_tss_num_lookups;
- NumInsertProbes = cur->MR_tss_num_insert_probes;
- NumLookupProbes = cur->MR_tss_num_lookup_probes;
- NumResizes = cur->MR_tss_num_resizes;
- NumResizesOld = cur->MR_tss_num_resizes_old_entries;
- NumResizesNew = cur->MR_tss_num_resizes_new_entries;
-
- PrevNumAllocs = prev->MR_tss_num_allocs;
- PrevNumInserts = prev->MR_tss_num_inserts;
- PrevNumLookups = prev->MR_tss_num_lookups;
- PrevNumInsertProbes = prev->MR_tss_num_insert_probes;
- PrevNumLookupProbes = prev->MR_tss_num_lookup_probes;
- PrevNumResizes = prev->MR_tss_num_resizes;
- PrevNumResizesOld = prev->MR_tss_num_resizes_old_entries;
- PrevNumResizesNew = prev->MR_tss_num_resizes_new_entries;
-").
-
-:- pred copy_current_stats_to_prev(ml_proc_table_info::in,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
- copy_current_stats_to_prev(Info::in, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, does_not_affect_liveness],
-"
- int i;
- MR_TableStepStats *cur;
- MR_TableStepStats *prev;
-
- Info->MR_pt_prev_call_table_lookups = Info->MR_pt_call_table_lookups;
- Info->MR_pt_prev_call_table_not_dupl = Info->MR_pt_call_table_not_dupl;
- Info->MR_pt_prev_answer_table_lookups = Info->MR_pt_answer_table_lookups;
- Info->MR_pt_prev_answer_table_not_dupl = Info->MR_pt_answer_table_not_dupl;
-
- for (i = 0; i < Info->MR_pt_num_inputs; i++) {
- cur = &Info->MR_pt_call_table_stats[i];
- prev = &Info->MR_pt_prev_call_table_stats[i];
- MR_copy_table_step_stats(prev, cur);
- }
-
- if (Info->MR_pt_has_answer_table) {
- for (i = 0; i < Info->MR_pt_num_outputs; i++) {
- cur = &Info->MR_pt_answer_table_stats[i];
- prev = &Info->MR_pt_prev_answer_table_stats[i];
- MR_copy_table_step_stats(prev, cur);
- }
- }
-").
-
%-----------------------------------------------------------------------------%
:- interface.
Index: library/table_statistics.m
===================================================================
RCS file: library/table_statistics.m
diff -N library/table_statistics.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/table_statistics.m 31 Dec 2007 08:08:17 -0000
@@ -0,0 +1,896 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: table_statistics.m.
+% Author: zs.
+% Stability: low.
+%
+% This file is automatically imported, as if via `use_module', into every
+% module that contains a `pragma memo' that asks the compiler to create
+% a predicate for returning statistics about the memo table. It defines
+% the data structure that this predicate will return, and some operations
+% on this data structure.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module table_statistics.
+:- interface.
+
+:- import_module io.
+:- import_module list.
+:- import_module maybe.
+
+:- type proc_table_statistics
+ ---> proc_table_statistics(
+ call_table_stats :: table_stats_curr_prev,
+ maybe_answer_table_stats :: maybe(table_stats_curr_prev)
+ ).
+
+:- type table_stats_curr_prev
+ ---> table_stats_curr_prev(
+ current_stats :: table_stats,
+ stats_at_last_call :: table_stats
+ ).
+
+:- type table_stats
+ ---> table_stats(
+ num_lookups :: int,
+ num_lookups_is_dupl :: int,
+ step_statistics :: list(table_step_stats)
+ ).
+
+ % The definition of this type be an enum whose implementation matches
+ % the type MR_TableTrieStep in runtime/mercury_tabling.h. It should also
+ % be kept in sync with the type table_trie_step in hlds_pred.m.
+:- type table_step_kind
+ ---> table_step_dummy
+ ; table_step_int
+ ; table_step_char
+ ; table_step_string
+ ; table_step_float
+ ; table_step_enum
+ ; table_step_general
+ ; table_step_general_addr
+ ; table_step_general_poly
+ ; table_step_general_poly_addr
+ ; table_step_typeinfo
+ ; table_step_typeclassinfo
+ ; table_step_promise_implied.
+
+:- type table_step_stats
+ ---> table_step_stats(
+ table_step_var_name :: string,
+ table_step_num_lookups :: int,
+ table_step_num_lookups_is_dupl :: int,
+ table_step_detail :: table_step_stat_details
+ ).
+
+:- type table_step_stat_details
+ ---> step_stats_none
+ ; step_stats_start(
+ start_num_node_allocs :: int,
+ start_num_node_bytes :: int
+ )
+ ; step_stats_enum(
+ enum_num_node_allocs :: int,
+ enum_num_node_bytes :: int
+ )
+ ; step_stats_hash(
+ hash_num_table_allocs :: int,
+ hash_num_table_bytes :: int,
+ hash_num_link_chunk_allocs :: int,
+ hash_num_link_chunk_bytes :: int,
+ hash_num_num_key_compares_not_dupl :: int,
+ hash_num_num_key_compares_dupl :: int,
+ hash_num_resizes :: int,
+ hash_resizes_num_old_entries :: int,
+ hash_resizes_num_new_entries :: int
+ )
+ ; step_stats_du(
+ du_num_node_allocs :: int,
+ du_num_node_bytes :: int,
+ du_num_arg_lookups :: int,
+ du_num_exist_lookups :: int,
+
+ du_enum_num_node_allocs :: int,
+ du_enum_num_node_bytes :: int,
+
+ du_hash_num_table_allocs :: int,
+ du_hash_num_table_bytes :: int,
+ du_hash_num_link_chunk_allocs :: int,
+ du_hash_num_link_chunk_bytes :: int,
+ du_hash_num_num_key_compares_not_dupl :: int,
+ du_hash_num_num_key_compares_dupl :: int,
+ du_hash_num_resizes :: int,
+ du_hash_resizes_num_old_entries :: int,
+ du_hash_resizes_num_new_entries :: int
+ )
+ ; step_stats_poly(
+ poly_du_num_node_allocs :: int,
+ poly_du_num_node_bytes :: int,
+ poly_du_num_arg_lookups :: int,
+ poly_du_num_exist_lookups :: int,
+
+ poly_enum_num_node_allocs :: int,
+ poly_enum_num_node_bytes :: int,
+
+ poly_hash_num_table_allocs :: int,
+ poly_hash_num_table_bytes :: int,
+ poly_hash_num_link_chunk_allocs :: int,
+ poly_hash_num_link_chunk_bytes :: int,
+ poly_hash_num_num_key_compares_not_dupl :: int,
+ poly_hash_num_num_key_compares_dupl :: int,
+ poly_hash_num_resizes :: int,
+ poly_hash_resizes_num_old_entries :: int,
+ poly_hash_resizes_num_new_entries :: int
+ ).
+
+:- func table_stats_difference(table_stats, table_stats) = table_stats.
+
+:- pred write_table_stats(table_stats::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module float.
+:- import_module int.
+:- import_module io.
+:- import_module require.
+:- import_module string.
+:- import_module table_builtin.
+
+:- pred get_tabling_stats(ml_proc_table_info::in, proc_table_statistics::out,
+ io::di, io::uo) is det.
+:- pragma foreign_export("C", get_tabling_stats(in, out, di, uo),
+ "MR_get_tabling_stats").
+:- pragma foreign_export("IL", get_tabling_stats(in, out, di, uo),
+ "MR_get_tabling_stats").
+
+get_tabling_stats(Info, Statistics, !IO) :-
+ get_proc_info_direct_fields(Info, HasAnswerTable, NumInputs, NumOutputs,
+ InputStepDescsPtr, OutputStepDescsPtr,
+ CurCallStatsPtr, PrevCallStatsPtr,
+ CurAnswerStatsPtr, PrevAnswerStatsPtr, !IO),
+ get_one_table_stats(InputStepDescsPtr, CurCallStatsPtr, NumInputs,
+ CurCallStats, !IO),
+ get_one_table_stats(InputStepDescsPtr, PrevCallStatsPtr, NumInputs,
+ PrevCallStats, !IO),
+ CallStats = table_stats_curr_prev(CurCallStats, PrevCallStats),
+ copy_current_stats_to_prev(CurCallStatsPtr, PrevCallStatsPtr,
+ NumInputs, !IO),
+ ( HasAnswerTable > 0 ->
+ get_one_table_stats(OutputStepDescsPtr, CurAnswerStatsPtr, NumOutputs,
+ CurAnswerStats, !IO),
+ get_one_table_stats(OutputStepDescsPtr, PrevAnswerStatsPtr, NumOutputs,
+ PrevAnswerStats, !IO),
+ AnswerStats = table_stats_curr_prev(CurAnswerStats, PrevAnswerStats),
+ copy_current_stats_to_prev(CurAnswerStatsPtr, PrevAnswerStatsPtr,
+ NumOutputs, !IO),
+ MaybeAnswerStats = yes(AnswerStats)
+ ;
+ MaybeAnswerStats = no
+ ),
+ Statistics = proc_table_statistics(CallStats, MaybeAnswerStats).
+
+:- type ml_table_step_desc_ptr ---> ml_table_step_desc_ptr(c_pointer).
+:- pragma foreign_type("C", ml_table_step_desc_ptr, "const MR_TableStepDesc *",
+ [can_pass_as_mercury_type]).
+:- pragma foreign_type(il, ml_table_step_desc_ptr,
+ "class [mscorlib]System.Object").
+
+:- type ml_table_stats_ptr ---> ml_table_stats_ptr(c_pointer).
+:- pragma foreign_type("C", ml_table_stats_ptr, "MR_TableStats *",
+ [can_pass_as_mercury_type]).
+:- pragma foreign_type(il, ml_table_stats_ptr,
+ "class [mscorlib]System.Object").
+
+:- pred get_proc_info_direct_fields(ml_proc_table_info::in,
+ int::out, int::out, int::out,
+ ml_table_step_desc_ptr::out, ml_table_step_desc_ptr::out,
+ ml_table_stats_ptr::out, ml_table_stats_ptr::out,
+ ml_table_stats_ptr::out, ml_table_stats_ptr::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_proc_info_direct_fields(Info::in,
+ HasAnswerTable::out, NumInputs::out, NumOutputs::out,
+ InputStepDescsPtr::out, OutputStepDescsPtr::out,
+ CurCallStatsPtr::out, PrevCallStatsPtr::out,
+ CurAnswerStatsPtr::out, PrevAnswerStatsPtr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, does_not_affect_liveness],
+"
+ HasAnswerTable = ( Info->MR_pt_has_answer_table ? 1 : 0 );
+ NumInputs = Info->MR_pt_num_inputs;
+ NumOutputs = Info->MR_pt_num_outputs;
+ InputStepDescsPtr = Info->MR_pt_steps_desc[MR_TABLE_CALL_TABLE];
+ OutputStepDescsPtr = Info->MR_pt_steps_desc[MR_TABLE_ANSWER_TABLE];
+ CurCallStatsPtr = &(Info->
+ MR_pt_stats[MR_TABLE_CALL_TABLE][MR_TABLE_STATS_CURR]);
+ PrevCallStatsPtr = &(Info->
+ MR_pt_stats[MR_TABLE_CALL_TABLE][MR_TABLE_STATS_PREV]);
+ CurAnswerStatsPtr = &(Info->
+ MR_pt_stats[MR_TABLE_ANSWER_TABLE][MR_TABLE_STATS_CURR]);
+ PrevAnswerStatsPtr = &(Info->
+ MR_pt_stats[MR_TABLE_ANSWER_TABLE][MR_TABLE_STATS_PREV]);
+").
+
+:- pred get_one_table_stats(ml_table_step_desc_ptr::in, ml_table_stats_ptr::in,
+ int::in, table_stats::out, io::di, io::uo) is det.
+
+get_one_table_stats(StepDescsPtr, StatsPtr, NumSteps, Stats, !IO) :-
+ get_one_table_overall_stats(StatsPtr, NumLookups, NumLookupsIsDupl, !IO),
+ get_one_table_stats_step_loop(StepDescsPtr, StatsPtr,
+ 0, NumSteps, [], StepStats, !IO),
+ Stats = table_stats(NumLookups, NumLookupsIsDupl, StepStats).
+
+:- pred get_one_table_overall_stats(ml_table_stats_ptr::in,
+ int::out, int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_one_table_overall_stats(StatsPtr::in,
+ NumLookups::out, NumLookupsIsDupl::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, does_not_affect_liveness],
+"
+ NumLookups = StatsPtr->MR_ts_num_lookups;
+ NumLookupsIsDupl = StatsPtr->MR_ts_num_lookups_is_dupl;
+").
+
+:- pred get_one_table_stats_step_loop(ml_table_step_desc_ptr::in,
+ ml_table_stats_ptr::in, int::in, int::in,
+ list(table_step_stats)::in, list(table_step_stats)::out,
+ io::di, io::uo) is det.
+
+get_one_table_stats_step_loop(StepDescsPtr, StatsPtr, CurStep, NumSteps,
+ !StepStats, !IO) :-
+ ( CurStep >= NumSteps ->
+ true
+ ;
+ get_one_table_stats_step_loop(StepDescsPtr, StatsPtr,
+ CurStep + 1, NumSteps, !StepStats, !IO),
+ get_one_table_step_stats(StepDescsPtr, StatsPtr, CurStep, StepStats,
+ !IO),
+ !:StepStats = [StepStats | !.StepStats]
+ ).
+
+:- pred get_one_table_step_stats(ml_table_step_desc_ptr::in,
+ ml_table_stats_ptr::in, int::in, table_step_stats::out, io::di, io::uo)
+ is det.
+
+get_one_table_step_stats(StepDescsPtr, StatsPtr, StepNum, Stats, !IO) :-
+ get_one_table_step_stat_details(StepDescsPtr, StatsPtr, StepNum, VarName,
+ NumLookups, NumLookupsIsDupl, KindInt,
+ HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries,
+ EnumNodeAllocs, EnumNodeBytes,
+ DuNodeAllocs, DuNodeBytes, DuArgLookups, DuExistLookups,
+ StartAllocs, StartBytes, !IO),
+ ( KindInt = 0 -> % MR_TABLE_STATS_DETAIL_HASH
+ (
+ EnumNodeAllocs = 0,
+ EnumNodeBytes = 0,
+ DuNodeAllocs = 0,
+ DuNodeBytes = 0,
+ DuArgLookups = 0,
+ DuExistLookups = 0,
+ StartAllocs = 0,
+ StartBytes = 0
+ ->
+ Details = step_stats_hash(HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries)
+ ;
+ error("get_one_table_step_stat_details: extra counts for hash")
+ )
+ ; KindInt = 1 -> % MR_TABLE_STATS_DETAIL_ENUM
+ (
+ HashTableAllocs = 0,
+ HashTableBytes = 0,
+ HashLinkChunkAllocs = 0,
+ HashLinkChunkBytes = 0,
+ HashKeyComparesNotDupl = 0,
+ HashKeyComparesIsDupl = 0,
+ HashResizes = 0,
+ HashResizeOldEntries = 0,
+ HashResizeNewEntries = 0,
+ DuNodeAllocs = 0,
+ DuNodeBytes = 0,
+ DuArgLookups = 0,
+ DuExistLookups = 0,
+ StartAllocs = 0,
+ StartBytes = 0
+ ->
+ Details = step_stats_enum(EnumNodeAllocs, EnumNodeBytes)
+ ;
+ error("get_one_table_step_stat_details: extra counts for enum")
+ )
+ ; KindInt = 2 -> % MR_TABLE_STATS_DETAIL_START
+ (
+ HashTableAllocs = 0,
+ HashTableBytes = 0,
+ HashLinkChunkAllocs = 0,
+ HashLinkChunkBytes = 0,
+ HashKeyComparesNotDupl = 0,
+ HashKeyComparesIsDupl = 0,
+ HashResizes = 0,
+ HashResizeOldEntries = 0,
+ HashResizeNewEntries = 0,
+ EnumNodeAllocs = 0,
+ EnumNodeBytes = 0,
+ DuNodeAllocs = 0,
+ DuNodeBytes = 0,
+ DuArgLookups = 0,
+ DuExistLookups = 0
+ ->
+ Details = step_stats_start(StartAllocs, StartBytes)
+ ;
+ error("get_one_table_step_stat_details: extra counts for start")
+ )
+ ; KindInt = 3 -> % MR_TABLE_STATS_DETAIL_DU
+ (
+ StartAllocs = 0,
+ StartBytes = 0
+ ->
+ Details = step_stats_du(DuNodeAllocs, DuNodeBytes,
+ DuArgLookups, DuExistLookups, EnumNodeAllocs, EnumNodeBytes,
+ HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries)
+ ;
+ error("get_one_table_step_stat_details: extra counts for du")
+ )
+ ; KindInt = 4 -> % MR_TABLE_STATS_DETAIL_POLY
+ (
+ StartAllocs = 0,
+ StartBytes = 0
+ ->
+ Details = step_stats_poly(DuNodeAllocs, DuNodeBytes,
+ DuArgLookups, DuExistLookups, EnumNodeAllocs, EnumNodeBytes,
+ HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries)
+ ;
+ error("get_one_table_step_stat_details: extra counts for poly")
+ )
+ ; KindInt = 5 -> % MR_TABLE_STATS_DETAIL_NONE
+ (
+ HashTableAllocs = 0,
+ HashTableBytes = 0,
+ HashLinkChunkAllocs = 0,
+ HashKeyComparesNotDupl = 0,
+ HashKeyComparesIsDupl = 0,
+ HashResizes = 0,
+ HashResizeOldEntries = 0,
+ HashResizeNewEntries = 0,
+ EnumNodeAllocs = 0,
+ EnumNodeBytes = 0,
+ DuNodeAllocs = 0,
+ DuNodeBytes = 0,
+ DuArgLookups = 0,
+ DuExistLookups = 0,
+ StartAllocs = 0,
+ StartBytes = 0
+ ->
+ Details = step_stats_none
+ ;
+ error("get_one_table_step_stat_details: extra counts for none")
+ )
+ ;
+ error("get_one_table_step_stat_details: unexpected detail kind")
+ ),
+ Stats = table_step_stats(VarName, NumLookups, NumLookupsIsDupl, Details).
+
+:- pred get_one_table_step_stat_details(ml_table_step_desc_ptr::in,
+ ml_table_stats_ptr::in, int::in,
+ string::out, int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out, int::out, int::out,
+ int::out, int::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_one_table_step_stat_details(StepDescsPtr::in, StatsStructPtr::in,
+ StepNum::in, VarName::out, NumLookups::out, NumLookupsIsDupl::out,
+ KindInt::out,
+ HashTableAllocs::out, HashTableBytes::out,
+ HashLinkChunkAllocs::out, HashLinkChunkBytes::out,
+ HashKeyComparesNotDupl::out, HashKeyComparesIsDupl::out,
+ HashResizes::out, HashResizeOldEntries::out, HashResizeNewEntries::out,
+ EnumNodeAllocs::out,EnumNodeBytes::out,
+ DuNodeAllocs::out, DuNodeBytes::out,
+ DuArgLookups::out, DuExistLookups::out,
+ StartAllocs::out, StartBytes::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, does_not_affect_liveness],
+"
+ const MR_TableStepStats *ptr;
+
+ ptr = &(StatsStructPtr->MR_ts_steps[StepNum]);
+
+ /* The casts are to discard const. */
+ VarName = (MR_String) (MR_Integer) StepDescsPtr[StepNum].MR_tsd_var_name;
+
+ NumLookups = ptr->MR_tss_num_lookups;
+ NumLookupsIsDupl = ptr->MR_tss_num_lookups_is_dupl;
+
+ KindInt = (MR_Integer) ptr->MR_tss_detail_kind;
+
+ HashTableAllocs = ptr->MR_tss_hash_num_table_allocs;
+ HashTableBytes = ptr->MR_tss_hash_num_table_alloc_bytes;
+ HashLinkChunkAllocs = ptr->MR_tss_hash_num_link_chunk_allocs;
+ HashLinkChunkBytes = ptr->MR_tss_hash_num_link_chunk_alloc_bytes;
+ HashKeyComparesNotDupl = ptr->MR_tss_hash_num_key_compares_not_dupl;
+ HashKeyComparesIsDupl = ptr->MR_tss_hash_num_key_compares_dupl;
+ HashResizes = ptr->MR_tss_hash_num_resizes;
+ HashResizeOldEntries = ptr->MR_tss_hash_resize_old_entries;
+ HashResizeNewEntries = ptr->MR_tss_hash_resize_new_entries;
+
+ EnumNodeAllocs = ptr->MR_tss_enum_num_node_allocs;
+ EnumNodeBytes = ptr->MR_tss_enum_num_node_alloc_bytes;
+
+ DuNodeAllocs = ptr->MR_tss_du_num_node_allocs;
+ DuNodeBytes = ptr->MR_tss_du_num_node_alloc_bytes;
+ DuArgLookups = ptr->MR_tss_du_num_arg_lookups;
+ DuExistLookups = ptr->MR_tss_du_num_exist_lookups;
+
+ StartAllocs = ptr->MR_tss_start_num_allocs;
+ StartBytes = ptr->MR_tss_start_num_alloc_bytes;
+").
+
+:- pred copy_current_stats_to_prev(ml_table_stats_ptr::in,
+ ml_table_stats_ptr::in, int::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ copy_current_stats_to_prev(CurPtr::in, PrevPtr::in, NumSteps::in,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, does_not_affect_liveness],
+"
+ MR_TableStepStats *cur;
+ MR_TableStepStats *prev;
+ int i;
+
+ PrevPtr->MR_ts_num_lookups = CurPtr->MR_ts_num_lookups;
+ PrevPtr->MR_ts_num_lookups_is_dupl = CurPtr->MR_ts_num_lookups_is_dupl;
+
+ for (i = 0; i < NumSteps; i++) {
+ cur = &(CurPtr->MR_ts_steps[i]);
+ prev = &(PrevPtr->MR_ts_steps[i]);
+
+ prev->MR_tss_num_lookups =
+ cur->MR_tss_num_lookups;
+ prev->MR_tss_num_lookups_is_dupl =
+ cur->MR_tss_num_lookups_is_dupl;
+
+ prev->MR_tss_hash_num_table_allocs =
+ cur->MR_tss_hash_num_table_allocs;
+ prev->MR_tss_hash_num_table_alloc_bytes =
+ cur->MR_tss_hash_num_table_alloc_bytes;
+ prev->MR_tss_hash_num_link_chunk_allocs =
+ cur->MR_tss_hash_num_link_chunk_allocs;
+ prev->MR_tss_hash_num_link_chunk_alloc_bytes =
+ cur->MR_tss_hash_num_link_chunk_alloc_bytes;
+ prev->MR_tss_hash_num_key_compares_not_dupl =
+ cur->MR_tss_hash_num_key_compares_not_dupl;
+ prev->MR_tss_hash_num_key_compares_dupl =
+ cur->MR_tss_hash_num_key_compares_dupl;
+ prev->MR_tss_hash_num_resizes =
+ cur->MR_tss_hash_num_resizes;
+ prev->MR_tss_hash_resize_old_entries =
+ cur->MR_tss_hash_resize_old_entries;
+ prev->MR_tss_hash_resize_new_entries =
+ cur->MR_tss_hash_resize_new_entries;
+
+ prev->MR_tss_enum_num_node_allocs =
+ cur->MR_tss_enum_num_node_allocs;
+ prev->MR_tss_enum_num_node_alloc_bytes =
+ cur->MR_tss_enum_num_node_alloc_bytes;
+
+ prev->MR_tss_du_num_node_allocs =
+ cur->MR_tss_du_num_node_allocs;
+ prev->MR_tss_du_num_node_alloc_bytes =
+ cur->MR_tss_du_num_node_alloc_bytes;
+ prev->MR_tss_du_num_arg_lookups =
+ cur->MR_tss_du_num_arg_lookups;
+ prev->MR_tss_du_num_exist_lookups =
+ cur->MR_tss_du_num_exist_lookups;
+
+ prev->MR_tss_start_num_allocs =
+ cur->MR_tss_start_num_allocs;
+ prev->MR_tss_start_num_alloc_bytes =
+ cur->MR_tss_start_num_alloc_bytes;
+ }
+").
+
+%-----------------------------------------------------------------------------%
+
+table_stats_difference(StatsA, StatsB) = StatsDiff :-
+ StatsA = table_stats(LookupsA, LookupsIsDuplA, StepsA),
+ StatsB = table_stats(LookupsB, LookupsIsDuplB, StepsB),
+
+ LookupsDiff = LookupsA - LookupsB,
+ LookupsIsDuplDiff = LookupsIsDuplA - LookupsIsDuplB,
+ StepsDiff = table_step_stats_diff(StepsA, StepsB),
+
+ StatsDiff = table_stats(LookupsDiff, LookupsIsDuplDiff, StepsDiff).
+
+:- func table_step_stats_diff(list(table_step_stats), list(table_step_stats))
+ = list(table_step_stats).
+
+table_step_stats_diff([], []) = [].
+table_step_stats_diff([_ | _], []) = func_error("mismatched table stats").
+table_step_stats_diff([], [_ | _]) = func_error("mismatched table stats").
+table_step_stats_diff([StepA | StepsA], [StepB | StepsB])
+ = [StepDiff | StepDiffs] :-
+ StepA = table_step_stats(VarNameA, LookupsA, LookupsIsDuplA, DetailsA),
+ StepB = table_step_stats(VarNameB, LookupsB, LookupsIsDuplB, DetailsB),
+
+ require(unify(VarNameA, VarNameB),
+ "table_step_stats_diff: mismatches in variable name"),
+ LookupsDiff = LookupsA - LookupsB,
+ LookupsIsDuplDiff = LookupsIsDuplA - LookupsIsDuplB,
+ ( table_step_stats_detail_diff(DetailsA, DetailsB, DetailsDiffPrime) ->
+ DetailsDiff = DetailsDiffPrime
+ ;
+ error("table_step_stats_diff: mismatches in details")
+ ),
+
+ StepDiff = table_step_stats(VarNameA, LookupsDiff, LookupsIsDuplDiff,
+ DetailsDiff),
+ StepDiffs = table_step_stats_diff(StepsA, StepsB).
+
+:- pred table_step_stats_detail_diff(table_step_stat_details::in,
+ table_step_stat_details::in, table_step_stat_details::out) is semidet.
+
+table_step_stats_detail_diff(DetailsA, DetailsB, DetailsDiff) :-
+ (
+ DetailsA = step_stats_none,
+ DetailsB = step_stats_none,
+ DetailsDiff = step_stats_none
+ ;
+ DetailsA = step_stats_start(StartAllocsA, StartBytesA),
+ DetailsB = step_stats_start(StartAllocsB, StartBytesB),
+ DetailsDiff = step_stats_start(StartAllocsA - StartAllocsB,
+ StartBytesA - StartBytesB)
+ ;
+ DetailsA = step_stats_enum(EnumNodeAllocsA, EnumNodeBytesA),
+ DetailsB = step_stats_enum(EnumNodeAllocsB, EnumNodeBytesB),
+ DetailsDiff = step_stats_enum(EnumNodeAllocsA - EnumNodeAllocsB,
+ EnumNodeBytesA - EnumNodeBytesB)
+ ;
+ DetailsA = step_stats_hash(HashTableAllocsA, HashTableBytesA,
+ HashLinkChunkAllocsA, HashLinkChunkBytesA,
+ HashKeyComparesNotDuplA, HashKeyComparesIsDuplA,
+ HashResizesA, HashResizeOldEntriesA, HashResizeNewEntriesA),
+ DetailsB = step_stats_hash(HashTableAllocsB, HashTableBytesB,
+ HashLinkChunkAllocsB, HashLinkChunkBytesB,
+ HashKeyComparesNotDuplB, HashKeyComparesIsDuplB,
+ HashResizesB, HashResizeOldEntriesB, HashResizeNewEntriesB),
+ DetailsDiff = step_stats_hash(HashTableAllocsA - HashTableAllocsB,
+ HashTableBytesA - HashTableBytesB,
+ HashLinkChunkAllocsA - HashLinkChunkAllocsB,
+ HashLinkChunkBytesA - HashLinkChunkBytesB,
+ HashKeyComparesNotDuplA - HashKeyComparesNotDuplB,
+ HashKeyComparesIsDuplA - HashKeyComparesIsDuplB,
+ HashResizesA - HashResizesB,
+ HashResizeOldEntriesA - HashResizeOldEntriesB,
+ HashResizeNewEntriesA - HashResizeNewEntriesB)
+ ;
+ DetailsA = step_stats_du(DuNodeAllocsA, DuNodeBytesA,
+ DuArgLookupsA, DuExistLookupsA, EnumNodeAllocsA, EnumNodeBytesA,
+ HashTableAllocsA, HashTableBytesA,
+ HashLinkChunkAllocsA, HashLinkChunkBytesA,
+ HashKeyComparesNotDuplA, HashKeyComparesIsDuplA,
+ HashResizesA, HashResizeOldEntriesA, HashResizeNewEntriesA),
+ DetailsB = step_stats_du(DuNodeAllocsB, DuNodeBytesB,
+ DuArgLookupsB, DuExistLookupsB, EnumNodeAllocsB, EnumNodeBytesB,
+ HashTableAllocsB, HashTableBytesB,
+ HashLinkChunkAllocsB, HashLinkChunkBytesB,
+ HashKeyComparesNotDuplB, HashKeyComparesIsDuplB,
+ HashResizesB, HashResizeOldEntriesB, HashResizeNewEntriesB),
+ DetailsDiff = step_stats_du(DuNodeAllocsA - DuNodeAllocsB,
+ DuNodeBytesA - DuNodeBytesB,
+ DuArgLookupsA - DuArgLookupsB,
+ DuExistLookupsA - DuExistLookupsB,
+ EnumNodeAllocsA - EnumNodeAllocsB,
+ EnumNodeBytesA - EnumNodeBytesB,
+ HashTableAllocsA - HashTableAllocsB,
+ HashTableBytesA - HashTableBytesB,
+ HashLinkChunkAllocsA - HashLinkChunkAllocsB,
+ HashLinkChunkBytesA - HashLinkChunkBytesB,
+ HashKeyComparesNotDuplA - HashKeyComparesNotDuplB,
+ HashKeyComparesIsDuplA - HashKeyComparesIsDuplB,
+ HashResizesA - HashResizesB,
+ HashResizeOldEntriesA - HashResizeOldEntriesB,
+ HashResizeNewEntriesA - HashResizeNewEntriesB)
+ ;
+ DetailsA = step_stats_poly(DuNodeAllocsA, DuNodeBytesA,
+ DuArgLookupsA, DuExistLookupsA, EnumNodeAllocsA, EnumNodeBytesA,
+ HashTableAllocsA, HashTableBytesA,
+ HashLinkChunkAllocsA, HashLinkChunkBytesA,
+ HashKeyComparesNotDuplA, HashKeyComparesIsDuplA,
+ HashResizesA, HashResizeOldEntriesA, HashResizeNewEntriesA),
+ DetailsB = step_stats_poly(DuNodeAllocsB, DuNodeBytesB,
+ DuArgLookupsB, DuExistLookupsB, EnumNodeAllocsB, EnumNodeBytesB,
+ HashTableAllocsB, HashTableBytesB,
+ HashLinkChunkAllocsB, HashLinkChunkBytesB,
+ HashKeyComparesNotDuplB, HashKeyComparesIsDuplB,
+ HashResizesB, HashResizeOldEntriesB, HashResizeNewEntriesB),
+ DetailsDiff = step_stats_poly(DuNodeAllocsA - DuNodeAllocsB,
+ DuNodeBytesA - DuNodeBytesB,
+ DuArgLookupsA - DuArgLookupsB,
+ DuExistLookupsA - DuExistLookupsB,
+ EnumNodeAllocsA - EnumNodeAllocsB,
+ EnumNodeBytesA - EnumNodeBytesB,
+ HashTableAllocsA - HashTableAllocsB,
+ HashTableBytesA - HashTableBytesB,
+ HashLinkChunkAllocsA - HashLinkChunkAllocsB,
+ HashLinkChunkBytesA - HashLinkChunkBytesB,
+ HashKeyComparesNotDuplA - HashKeyComparesNotDuplB,
+ HashKeyComparesIsDuplA - HashKeyComparesIsDuplB,
+ HashResizesA - HashResizesB,
+ HashResizeOldEntriesA - HashResizeOldEntriesB,
+ HashResizeNewEntriesA - HashResizeNewEntriesB)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+write_table_stats(Stats, !IO) :-
+ Stats = table_stats(Lookups, LookupsIsDupl, Steps),
+
+ LookupsNotDupl = Lookups - LookupsIsDupl,
+ LookupsStr = string.int_to_string_thousands(Lookups),
+ LookupsIsDuplStr = string.int_to_string_thousands(LookupsIsDupl),
+ LookupsNotDuplStr = string.int_to_string_thousands(LookupsNotDupl),
+
+ io.format("number of lookups: %9s\n",
+ [s(LookupsStr)], !IO),
+ ( Lookups > 0 ->
+ FractionIsDuplStr = percentage_str(LookupsIsDupl, Lookups),
+ FractionNotDuplStr = percentage_str(LookupsNotDupl, Lookups),
+
+ io.format("number of successful lookups (old calls): %9s %9s\n",
+ [s(LookupsIsDuplStr), s(FractionIsDuplStr)], !IO),
+ io.format("number of unsuccessful lookups (new calls): %9s %9s\n",
+ [s(LookupsNotDuplStr), s(FractionNotDuplStr)], !IO),
+ io.write_string("statistics for the individual steps:\n", !IO),
+ list.foldl2(write_table_step_stats_loop, Steps, 1, _, !IO)
+ ;
+ true
+ ).
+
+:- pred write_table_step_stats_loop(table_step_stats::in, int::in, int::out,
+ io::di, io::uo) is det.
+
+write_table_step_stats_loop(Step, !StepNum, !IO) :-
+ write_table_step_stats(Step, !.StepNum, !IO),
+ !:StepNum = !.StepNum + 1.
+
+:- pred write_table_step_stats_header(string::in, int::in, string::in,
+ int::in, int::in, io::di, io::uo) is det.
+
+write_table_step_stats_header(VarName, StepNum, KindStr,
+ Lookups, LookupsIsDupl, !IO) :-
+ io.format("\nstep %d, variable %s: %s\n",
+ [i(StepNum), s(VarName), s(KindStr)], !IO),
+
+ LookupsNotDupl = Lookups - LookupsIsDupl,
+ LookupsStr = string.int_to_string_thousands(Lookups),
+ LookupsIsDuplStr = string.int_to_string_thousands(LookupsIsDupl),
+ LookupsNotDuplStr = string.int_to_string_thousands(LookupsNotDupl),
+
+ io.format(" number of lookups: %9s\n",
+ [s(LookupsStr)], !IO),
+ ( Lookups > 0 ->
+ FractionIsDuplStr = percentage_str(LookupsIsDupl, Lookups),
+ FractionNotDuplStr = percentage_str(LookupsNotDupl, Lookups),
+
+ io.format(" number of successful lookups: %9s %9s\n",
+ [s(LookupsIsDuplStr), s(FractionIsDuplStr)], !IO),
+ io.format(" number of unsuccessful lookups: %9s %9s\n",
+ [s(LookupsNotDuplStr), s(FractionNotDuplStr)], !IO)
+ ;
+ true
+ ).
+
+:- pred write_table_step_stats_start(int::in, int::in, io::di, io::uo) is det.
+
+write_table_step_stats_start(StartAllocs, StartBytes, !IO) :-
+ StartAllocsStr = string.int_to_string_thousands(StartAllocs),
+ StartBytesStr = string.int_to_string_thousands(StartBytes),
+ io.format(" number of array (re)allocations: %9s\n",
+ [s(StartAllocsStr)], !IO),
+ io.format(" number of bytes (re)allocationed: %9s\n",
+ [s(StartBytesStr)], !IO).
+
+:- pred write_table_step_stats_enum(int::in, int::in, io::di, io::uo) is det.
+
+write_table_step_stats_enum(EnumNodeAllocs, EnumNodeBytes, !IO) :-
+ EnumNodeAllocsStr = string.int_to_string_thousands(EnumNodeAllocs),
+ EnumNodeBytesStr = string.int_to_string_thousands(EnumNodeBytes),
+ io.format(" number of enum node allocations: %9s\n",
+ [s(EnumNodeAllocsStr)], !IO),
+ io.format(" number of bytes allocated for enum nodes: %9s\n",
+ [s(EnumNodeBytesStr)], !IO).
+
+:- pred write_table_step_stats_hash(int::in, int::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in, io::di, io::uo) is det.
+
+write_table_step_stats_hash(HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries, !IO) :-
+ HashTableAllocsStr =
+ string.int_to_string_thousands(HashTableAllocs),
+ HashTableBytesStr =
+ string.int_to_string_thousands(HashTableBytes),
+ HashLinkChunkAllocsStr =
+ string.int_to_string_thousands(HashLinkChunkAllocs),
+ HashLinkChunkBytesStr =
+ string.int_to_string_thousands(HashLinkChunkBytes),
+ HashKeyComparesNotDuplStr =
+ string.int_to_string_thousands(HashKeyComparesNotDupl),
+ HashKeyComparesIsDuplStr =
+ string.int_to_string_thousands(HashKeyComparesIsDupl),
+ HashResizesStr =
+ string.int_to_string_thousands(HashResizes),
+ HashResizeOldEntriesStr =
+ string.int_to_string_thousands(HashResizeOldEntries),
+ HashResizeNewEntriesStr =
+ string.int_to_string_thousands(HashResizeNewEntries),
+ io.format(" number of hash table allocations: %9s\n",
+ [s(HashTableAllocsStr)], !IO),
+ io.format(" number of bytes allocated for hash tables: %9s\n",
+ [s(HashTableBytesStr)], !IO),
+ io.format(" number of bulk hash link allocations: %9s\n",
+ [s(HashLinkChunkAllocsStr)], !IO),
+ io.format(" number of bytes allocated for hash links: %9s\n",
+ [s(HashLinkChunkBytesStr)], !IO),
+ io.format(" number of key compares when unsuccessful: %9s\n",
+ [s(HashKeyComparesNotDuplStr)], !IO),
+ io.format(" number of key compares when successful: %9s\n",
+ [s(HashKeyComparesIsDuplStr)], !IO),
+ io.format(" number of hash table resizes: %9s\n",
+ [s(HashResizesStr)], !IO),
+ ( HashResizes > 0 ->
+ io.format(" number of old entries in resizes: %9s\n",
+ [s(HashResizeOldEntriesStr)], !IO),
+ io.format(" number of new entries in resizes: %9s\n",
+ [s(HashResizeNewEntriesStr)], !IO)
+ ;
+ true
+ ).
+
+:- pred write_table_step_stats_du(int::in, int::in, int::in, int::in,
+ io::di, io::uo) is det.
+
+write_table_step_stats_du(DuNodeAllocs, DuNodeBytes,
+ DuArgLookups, DuExistLookups, !IO) :-
+ DuNodeAllocsStr = string.int_to_string_thousands(DuNodeAllocs),
+ DuNodeBytesStr = string.int_to_string_thousands(DuNodeBytes),
+ DuArgLookupsStr = string.int_to_string_thousands(DuArgLookups),
+ DuExistLookupsStr = string.int_to_string_thousands(DuExistLookups),
+ io.format(" number of du functor node allocations: %9s\n",
+ [s(DuNodeAllocsStr)], !IO),
+ io.format(" number of bytes allocated for du functors: %9s\n",
+ [s(DuNodeBytesStr)], !IO),
+ io.format(" number of du functor argument lookups: %9s\n",
+ [s(DuArgLookupsStr)], !IO),
+ ( DuExistLookups > 0 ->
+ io.format(" number of du existential type lookups: %9s\n",
+ [s(DuExistLookupsStr)], !IO)
+ ;
+ true
+ ).
+
+:- pred write_table_step_stats(table_step_stats::in, int::in,
+ io::di, io::uo) is det.
+
+write_table_step_stats(Step, StepNum, !IO) :-
+ Step = table_step_stats(VarName, Lookups, LookupsIsDupl, Details),
+ (
+ Details = step_stats_none,
+ write_table_step_stats_header(VarName, StepNum, "none",
+ Lookups, LookupsIsDupl, !IO)
+ ;
+ Details = step_stats_start(StartAllocs, StartBytes),
+ write_table_step_stats_header(VarName, StepNum, "expandable array",
+ Lookups, LookupsIsDupl, !IO),
+ ( Lookups > 0 ->
+ write_table_step_stats_start(StartAllocs, StartBytes, !IO)
+ ;
+ true
+ )
+ ;
+ Details = step_stats_enum(EnumNodeAllocs, EnumNodeBytes),
+ write_table_step_stats_header(VarName, StepNum, "enum trie",
+ Lookups, LookupsIsDupl, !IO),
+ ( Lookups > 0 ->
+ write_table_step_stats_enum(EnumNodeAllocs, EnumNodeBytes, !IO)
+ ;
+ true
+ )
+ ;
+ Details = step_stats_hash(HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries),
+ write_table_step_stats_header(VarName, StepNum, "hash table",
+ Lookups, LookupsIsDupl, !IO),
+ ( Lookups > 0 ->
+ write_table_step_stats_hash(HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries, !IO)
+ ;
+ true
+ )
+ ;
+ (
+ Details = step_stats_du(DuNodeAllocs, DuNodeBytes,
+ DuArgLookups, DuExistLookups, EnumNodeAllocs, EnumNodeBytes,
+ HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries),
+ KindStr = "discriminated union nested trie",
+ MustHaveDu = yes
+ ;
+ Details = step_stats_poly(DuNodeAllocs, DuNodeBytes,
+ DuArgLookups, DuExistLookups, EnumNodeAllocs, EnumNodeBytes,
+ HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries),
+ KindStr = "polymorphic table",
+ MustHaveDu = no
+ ),
+ write_table_step_stats_header(VarName, StepNum, KindStr,
+ Lookups, LookupsIsDupl, !IO),
+ ( Lookups > 0 ->
+ ( DuNodeAllocs > 0 ->
+ write_table_step_stats_du(DuNodeAllocs, DuNodeBytes,
+ DuArgLookups, DuExistLookups, !IO)
+ ;
+ (
+ MustHaveDu = no
+ ;
+ MustHaveDu = yes,
+ error("write_table_step_stats: no du stats")
+ )
+ ),
+ ( EnumNodeAllocs > 0 ->
+ write_table_step_stats_enum(EnumNodeAllocs, EnumNodeBytes, !IO)
+ ;
+ true
+ ),
+ ( HashTableAllocs > 0 ->
+ write_table_step_stats_hash(HashTableAllocs, HashTableBytes,
+ HashLinkChunkAllocs, HashLinkChunkBytes,
+ HashKeyComparesNotDupl, HashKeyComparesIsDupl,
+ HashResizes, HashResizeOldEntries, HashResizeNewEntries,
+ !IO)
+ ;
+ true
+ )
+ ;
+ true
+ )
+ ).
+
+:- func percentage_str(int, int) = string.
+
+percentage_str(A, B) = PercentageStr :-
+ Percentage = float(100) * float(A) / float(B),
+ string.format("(%.2f%%)", [f(Percentage)], PercentageStr).
cvs diff: Diffing mdbcomp
Index: mdbcomp/prim_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/prim_data.m,v
retrieving revision 1.26
diff -u -b -r1.26 prim_data.m
--- mdbcomp/prim_data.m 3 Oct 2007 23:48:17 -0000 1.26
+++ mdbcomp/prim_data.m 22 Oct 2007 02:25:29 -0000
@@ -214,6 +214,14 @@
%
:- func mercury_table_builtin_module = sym_name.
+ % Returns the name of the module that handles tabling statistics.
+ % This is separate from table_builtin, since its contents need to be
+ % visible to users, while the contents of table_builtin are private.
+ % This module is automatically imported iff any tabled predicate
+ % gather statistics.
+ %
+:- func mercury_table_statistics_module = sym_name.
+
% Returns the name of the module containing the builtins for deep
% profiling. This module is automatically imported iff deep profiling
% is enabled.
@@ -323,6 +331,7 @@
mercury_region_builtin_module,
mercury_stm_builtin_module,
mercury_table_builtin_module,
+ mercury_table_statistics_module,
mercury_profiling_builtin_module,
mercury_term_size_prof_builtin_module,
mercury_par_builtin_module,
@@ -337,6 +346,7 @@
mercury_region_builtin_module = unqualified("region_builtin").
mercury_stm_builtin_module = unqualified("stm_builtin").
mercury_table_builtin_module = unqualified("table_builtin").
+mercury_table_statistics_module = unqualified("table_statistics").
mercury_profiling_builtin_module = unqualified("profiling_builtin").
mercury_term_size_prof_builtin_module = unqualified("term_size_prof_builtin").
mercury_par_builtin_module = unqualified("par_builtin").
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_hash_lookup_or_add_body.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_hash_lookup_or_add_body.h,v
retrieving revision 1.2
diff -u -b -r1.2 mercury_hash_lookup_or_add_body.h
--- runtime/mercury_hash_lookup_or_add_body.h 8 Jun 2006 08:19:59 -0000 1.2
+++ runtime/mercury_hash_lookup_or_add_body.h 14 Nov 2007 02:55:04 -0000
@@ -17,13 +17,15 @@
table_type *slot;
MR_Integer abs_hash;
MR_Integer home;
- DECLARE_PROBE_COUNT
+ MR_TABLE_DECLARE_KEY_COMPARE_COUNT
debug_key_msg(key, key_format, key_cast);
/* Has the table been built? */
table = t->MR_hash_table; /* Deref the table pointer */
if (table == NULL) {
+ MR_table_record_hash_table_alloc_count(sizeof(MR_HashTable) +
+ (HASH_TABLE_START_SIZE * sizeof(MR_HashTableSlotPtr)));
MR_CREATE_HASH_TABLE(t->MR_hash_table, table_type,
table_field, HASH_TABLE_START_SIZE);
table = t->MR_hash_table; /* Deref the table pointer */
@@ -44,7 +46,7 @@
new_size = next_prime(old_size);
new_threshold = (MR_Integer) ((float) new_size * MAX_LOAD_FACTOR);
debug_resize_msg(old_size, new_size, new_threshold);
- record_resize_count(old_size, new_size);
+ MR_table_record_hash_resize_count(old_size, new_size);
new_hash_table = MR_TABLE_NEW_ARRAY(MR_HashTableSlotPtr, new_size);
for (new_bucket = 0; new_bucket < new_size; new_bucket++) {
@@ -88,11 +90,11 @@
hash_table = table->hash_table;
slot = hash_table[home].table_field;
while (slot != NULL) {
- debug_probe_msg(home);
- record_probe_count();
+ debug_key_compare_msg(home);
+ MR_table_record_hash_key_compare_count();
if (equal_keys(key, slot->key)) {
- record_lookup_count();
+ MR_table_record_hash_dupl_count();
debug_lookup_msg(home);
return &slot->data;
}
@@ -107,7 +109,7 @@
/* Add the element. */
debug_insert_msg(home);
- record_insert_count();
+ MR_table_record_hash_not_dupl_count();
if (table->freeleft == 0) {
MR_AllocRecord *record;
@@ -121,7 +123,8 @@
record->next = table->allocrecord;
table->allocrecord = record;
- record_alloc_count();
+ MR_table_record_hash_links_alloc_count(sizeof(MR_AllocRecord) +
+ (CHUNK_SIZE * sizeof(table_type)));
}
slot = table->freespace.table_field;
Index: runtime/mercury_table_int_fix_index_body.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_table_int_fix_index_body.h,v
retrieving revision 1.2
diff -u -b -r1.2 mercury_table_int_fix_index_body.h
--- runtime/mercury_table_int_fix_index_body.h 30 Nov 2006 05:22:42 -0000 1.2
+++ runtime/mercury_table_int_fix_index_body.h 14 Nov 2007 02:50:04 -0000
@@ -16,7 +16,7 @@
*/
if (t->MR_fix_table == NULL) {
- record_alloc();
+ MR_table_record_fix_alloc(sizeof(MR_TableNode) * range);
t->MR_fix_table = MR_TABLE_NEW_ARRAY(MR_TableNode, range);
MR_memset(t->MR_fix_table, 0, sizeof(MR_TableNode) * range);
}
Index: runtime/mercury_table_int_start_index_body.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_table_int_start_index_body.h,v
retrieving revision 1.2
diff -u -b -r1.2 mercury_table_int_start_index_body.h
--- runtime/mercury_table_int_start_index_body.h 30 Nov 2006 05:22:42 -0000 1.2
+++ runtime/mercury_table_int_start_index_body.h 14 Nov 2007 03:55:12 -0000
@@ -23,9 +23,9 @@
#endif
if (table->MR_start_table == NULL) {
- record_alloc();
size = MR_max(MR_START_TABLE_INIT_SIZE, diff + 1);
table->MR_start_table = MR_TABLE_NEW_ARRAY(MR_TableNode, size + 1);
+ MR_table_record_start_alloc(sizeof(MR_TableNode) * (size + 1));
MR_memset(table->MR_start_table + 1, 0, sizeof(MR_TableNode) * size);
table->MR_start_table[0].MR_integer = size;
} else {
@@ -38,6 +38,7 @@
new_size = MR_max(2 * size, diff + 1);
new_array = MR_TABLE_NEW_ARRAY(MR_TableNode, new_size + 1);
+ MR_table_record_start_alloc(sizeof(MR_TableNode) * (new_size + 1));
new_array[0].MR_integer = new_size;
Index: runtime/mercury_table_type_body.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_table_type_body.h,v
retrieving revision 1.6
diff -u -b -r1.6 mercury_table_type_body.h
--- runtime/mercury_table_type_body.h 20 Aug 2007 03:36:15 -0000 1.6
+++ runtime/mercury_table_type_body.h 31 Oct 2007 02:59:48 -0000
@@ -48,8 +48,11 @@
** substitute the constant zero, which ought to be the enum value
** assigned to the type's only function symbol.
**
- ** It would of course be preferable for the compiler to simply
- ** not insert any arguments of dummy types into tables.
+ ** We would like the compiler to simply not insert any arguments
+ ** of dummy types into tables. Unfortunately, while the compiler
+ ** can filter out any dummy arguments whose type is statically
+ ** known, it cannot do so for arguments whose type becomes known
+ ** only at runtime.
*/
MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table, 1, 0);
table = table_next;
@@ -71,7 +74,7 @@
if ((MR_Unsigned) data <
(MR_Unsigned) ra_layout->MR_ra_num_res_numeric_addrs)
{
- MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_TABLE_DU(STATS, DEBUG, BACK, table_next, table,
MR_type_ctor_num_functors(type_ctor_info),
ra_layout->MR_ra_constants[data]->
MR_ra_functor_ordinal);
@@ -90,7 +93,7 @@
int offset;
offset = i + ra_layout->MR_ra_num_res_numeric_addrs;
- MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_TABLE_DU(STATS, DEBUG, BACK, table_next, table,
MR_type_ctor_num_functors(type_ctor_info),
ra_layout->MR_ra_constants[offset]->
MR_ra_functor_ordinal);
@@ -143,15 +146,19 @@
case MR_SECTAG_LOCAL:
sectag = MR_unmkbody(data);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
- assert(functor_desc->MR_du_functor_orig_arity == 0);
- assert(functor_desc->MR_du_functor_exist_info == NULL);
+ functor_desc =
+ ptag_layout->MR_sectag_alternatives[sectag];
+ MR_table_assert(
+ functor_desc->MR_du_functor_orig_arity == 0);
+ MR_table_assert(
+ functor_desc->MR_du_functor_exist_info == NULL);
arg_vector = NULL;
break;
case MR_SECTAG_REMOTE:
sectag = MR_field(ptag, data, 0);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ functor_desc =
+ ptag_layout->MR_sectag_alternatives[sectag];
arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
break;
@@ -163,7 +170,7 @@
}
- MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_TABLE_DU(STATS, DEBUG, BACK, table_next, table,
MR_type_ctor_num_functors(type_ctor_info),
functor_desc->MR_du_functor_ordinal);
table = table_next;
@@ -181,6 +188,7 @@
locns = exist_info->MR_exist_typeinfo_locns;
for (i = 0; i < num_ti_plain + num_ti_in_tci; i++) {
+ MR_table_record_exist_lookup();
if (locns[i].MR_exist_offset_in_tci < 0) {
MR_TABLE_TYPEINFO(STATS, DEBUG, BACK,
table_next, table, (MR_TypeInfo)
@@ -211,6 +219,7 @@
functor_desc->MR_du_functor_arg_types[i]);
}
+ MR_table_record_arg_lookup();
MR_TABLE_ANY(STATS, DEBUG, BACK, "du arg",
table_next, table,
arg_type_info, arg_vector[meta_args + i]);
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.73
diff -u -b -r1.73 mercury_tabling.c
--- runtime/mercury_tabling.c 13 Feb 2007 01:58:58 -0000 1.73
+++ runtime/mercury_tabling.c 16 Nov 2007 00:44:27 -0000
@@ -21,6 +21,19 @@
#include <stdlib.h>
#include <string.h>
+static void MR_table_assert_failed(const char *file, unsigned line);
+
+#ifdef MR_TABLE_DEBUG
+#define MR_table_assert(cond) \
+ do { \
+ if (! (cond)) { \
+ MR_table_assert_failed(__FILE__, __LINE__); \
+ } \
+ }
+#else
+#define MR_table_assert(cond) ((void) 0)
+#endif
+
/*---------------------------------------------------------------------------*/
/*
@@ -203,10 +216,10 @@
** It in turn relies on three groups of macros to perform part of the task.
**
** The first group optionally records statistics about the number of successful
-** and unsuccessful searches, and the number of probes they needed. From this
-** information, one can compute the average successful and unsuccessful
-** search lengths. These macros are defined and undefined in the files
-** mercury_tabling_stats_{defs,nodefs,undefs}.h.
+** and unsuccessful searches, and the number of key comparisons they needed.
+** From this information, one can compute the average successful and
+** unsuccessful search lengths. These macros are defined and undefined in the
+** files mercury_tabling_stats_{defs,nodefs,undefs}.h.
**
** The second optionally prints debugging messages.
**
@@ -238,10 +251,11 @@
} \
} while (0)
- #define debug_probe_msg(probe_bucket) \
+ #define debug_key_compare_msg(home_bucket) \
do { \
if (MR_hashdebug) { \
- printf("HT probing bucket: %d\n", (probe_bucket)); \
+ printf("HT comparing keys in bucket: %d\n", \
+ (home_bucket)); \
} \
} while (0)
@@ -264,7 +278,7 @@
#define debug_key_msg(keyvalue, keyformat, keycast) ((void) 0)
#define debug_resize_msg(oldsize, newsize, newthreshold) ((void) 0)
#define debug_rehash_msg(rehash_bucket) ((void) 0)
- #define debug_probe_msg(probe_bucket) ((void) 0)
+ #define debug_key_compare_msg(home_bucket) ((void) 0)
#define debug_lookup_msg(home_bucket) ((void) 0)
#define debug_insert_msg(home_bucket) ((void) 0)
#endif
@@ -798,25 +812,54 @@
/*
** This part deals with tabling using fixed size tables simply indexed
-** by a given integer. t->MR_fix_table[i] contains the trie node for
-** key i.
+** by a given integer. t->MR_fix_table[i] contains the trie node for key i.
+**
+** The enum and the du_functor versions differ only in what statistics field
+** we increment.
*/
MR_TrieNode
-MR_int_fix_index_lookup_or_add(MR_TrieNode t, MR_Integer range, MR_Integer key)
+MR_int_fix_index_enum_lookup_or_add(MR_TrieNode t, MR_Integer range,
+ MR_Integer key)
+{
+#define MR_table_record_fix_alloc(numbytes) ((void) 0)
+#include "mercury_table_int_fix_index_body.h"
+#undef MR_table_record_fix_alloc
+}
+
+MR_TrieNode
+MR_int_fix_index_enum_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_Integer range, MR_Integer key)
+{
+#define MR_table_record_fix_alloc(numbytes) \
+ do { \
+ stats->MR_tss_enum_num_node_allocs++; \
+ stats->MR_tss_enum_num_node_alloc_bytes += (numbytes); \
+ } while(0)
+#include "mercury_table_int_fix_index_body.h"
+#undef MR_table_record_fix_alloc
+}
+
+MR_TrieNode
+MR_int_fix_index_du_lookup_or_add(MR_TrieNode t, MR_Integer range,
+ MR_Integer key)
{
-#define record_alloc() ((void) 0)
+#define MR_table_record_fix_alloc(numbytes) ((void) 0)
#include "mercury_table_int_fix_index_body.h"
-#undef record_alloc
+#undef MR_table_record_fix_alloc
}
MR_TrieNode
-MR_int_fix_index_lookup_or_add_stats(MR_TableStepStats *stats,
+MR_int_fix_index_du_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_Integer range, MR_Integer key)
{
-#define record_alloc() do { stats->MR_tss_num_allocs++; } while(0)
+#define MR_table_record_fix_alloc(numbytes) \
+ do { \
+ stats->MR_tss_du_num_node_allocs++; \
+ stats->MR_tss_du_num_node_alloc_bytes += (numbytes); \
+ } while(0)
#include "mercury_table_int_fix_index_body.h"
-#undef record_alloc
+#undef MR_table_record_fix_alloc
}
/*---------------------------------------------------------------------------*/
@@ -835,18 +878,22 @@
MR_int_start_index_lookup_or_add(MR_TrieNode table, MR_Integer start,
MR_Integer key)
{
-#define record_alloc() ((void) 0)
+#define MR_table_record_start_alloc(numbytes) ((void) 0)
#include "mercury_table_int_start_index_body.h"
-#undef record_alloc
+#undef MR_table_record_start_alloc
}
MR_TrieNode
MR_int_start_index_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode table, MR_Integer start, MR_Integer key)
{
-#define record_alloc() do { stats->MR_tss_num_allocs++; } while(0)
+#define MR_table_record_start_alloc(numbytes) \
+ do { \
+ stats->MR_tss_start_num_allocs++; \
+ stats->MR_tss_start_num_alloc_bytes += (numbytes); \
+ } while(0)
#include "mercury_table_int_start_index_body.h"
-#undef record_alloc
+#undef MR_table_record_start_alloc
}
/*---------------------------------------------------------------------------*/
@@ -896,11 +943,15 @@
#define STATS NULL
#define DEBUG MR_FALSE
#define BACK MR_FALSE
+#define MR_table_record_exist_lookup() ((void) 0)
+#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -910,11 +961,15 @@
#define STATS NULL
#define DEBUG MR_TRUE
#define BACK MR_FALSE
+#define MR_table_record_exist_lookup() ((void) 0)
+#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -925,11 +980,21 @@
#define STATS stats
#define DEBUG MR_FALSE
#define BACK MR_FALSE
+#define MR_table_record_exist_lookup() \
+ do { \
+ stats->MR_tss_du_num_exist_lookups++; \
+ } while(0)
+#define MR_table_record_arg_lookup() \
+ do { \
+ stats->MR_tss_du_num_arg_lookups++; \
+ } while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -940,11 +1005,21 @@
#define STATS stats
#define DEBUG MR_TRUE
#define BACK MR_FALSE
+#define MR_table_record_exist_lookup() \
+ do { \
+ stats->MR_tss_du_num_exist_lookups++; \
+ } while(0)
+#define MR_table_record_arg_lookup() \
+ do { \
+ stats->MR_tss_du_num_arg_lookups++; \
+ } while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -954,11 +1029,15 @@
#define STATS NULL
#define DEBUG MR_FALSE
#define BACK MR_TRUE
+#define MR_table_record_exist_lookup() ((void) 0)
+#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -969,11 +1048,15 @@
#define STATS NULL
#define DEBUG MR_TRUE
#define BACK MR_TRUE
+#define MR_table_record_exist_lookup() ((void) 0)
+#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -984,11 +1067,21 @@
#define STATS stats
#define DEBUG MR_FALSE
#define BACK MR_TRUE
+#define MR_table_record_exist_lookup() \
+ do { \
+ stats->MR_tss_du_num_exist_lookups++; \
+ } while(0)
+#define MR_table_record_arg_lookup() \
+ do { \
+ stats->MR_tss_du_num_arg_lookups++; \
+ } while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
MR_TrieNode
@@ -999,11 +1092,21 @@
#define STATS stats
#define DEBUG MR_TRUE
#define BACK MR_TRUE
+#define MR_table_record_exist_lookup() \
+ do { \
+ stats->MR_tss_du_num_exist_lookups++; \
+ } while(0)
+#define MR_table_record_arg_lookup() \
+ do { \
+ stats->MR_tss_du_num_arg_lookups++; \
+ } while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
+#undef MR_table_record_exist_lookup
+#undef MR_table_record_arg_lookup
}
/*---------------------------------------------------------------------------*/
@@ -1489,3 +1592,14 @@
#endif
/*---------------------------------------------------------------------------*/
+
+static void
+MR_table_assert_failed(const char *file, unsigned line)
+{
+ char buf[256];
+
+ snprintf(buf, 256, "assertion failed: file %s, line %d", file, line);
+ MR_fatal_error(buf);
+}
+
+/*---------------------------------------------------------------------------*/
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.44
diff -u -b -r1.44 mercury_tabling.h
--- runtime/mercury_tabling.h 15 Aug 2007 01:35:02 -0000 1.44
+++ runtime/mercury_tabling.h 31 Dec 2007 08:06:28 -0000
@@ -167,6 +167,8 @@
MR_Dlist *MR_type_table;
};
+#define MR_trie_node_seen_before(t) ((t)->MR_integer != 0)
+
struct MR_MemoNonRecord_Struct {
MR_TrieNode MR_mn_back_ptr;
MR_MemoNonStatus MR_mn_status;
@@ -259,60 +261,88 @@
typedef MR_Unsigned MR_Counter;
+typedef enum {
+ MR_TABLE_STATS_DETAIL_HASH,
+ MR_TABLE_STATS_DETAIL_ENUM,
+ MR_TABLE_STATS_DETAIL_START,
+ MR_TABLE_STATS_DETAIL_DU,
+ MR_TABLE_STATS_DETAIL_POLY,
+ MR_TABLE_STATS_DETAIL_NONE
+} MR_TableStepStatsKind;
+
struct MR_TableStepStats_Struct {
- MR_Counter MR_tss_num_allocs;
- MR_Counter MR_tss_num_inserts;
MR_Counter MR_tss_num_lookups;
- MR_Counter MR_tss_num_insert_probes;
- MR_Counter MR_tss_num_lookup_probes;
- MR_Counter MR_tss_num_resizes;
- MR_Counter MR_tss_num_resizes_old_entries;
- MR_Counter MR_tss_num_resizes_new_entries;
+ MR_Counter MR_tss_num_lookups_is_dupl;
+ MR_TableStepStatsKind MR_tss_detail_kind;
+
+ MR_Counter MR_tss_hash_num_table_allocs;
+ MR_Counter MR_tss_hash_num_table_alloc_bytes;
+ MR_Counter MR_tss_hash_num_link_chunk_allocs;
+ MR_Counter MR_tss_hash_num_link_chunk_alloc_bytes;
+ MR_Counter MR_tss_hash_num_key_compares_not_dupl;
+ MR_Counter MR_tss_hash_num_key_compares_dupl;
+ MR_Counter MR_tss_hash_num_resizes;
+ MR_Counter MR_tss_hash_resize_old_entries;
+ MR_Counter MR_tss_hash_resize_new_entries;
+
+ MR_Counter MR_tss_enum_num_node_allocs;
+ MR_Counter MR_tss_enum_num_node_alloc_bytes;
+
+ MR_Counter MR_tss_du_num_node_allocs;
+ MR_Counter MR_tss_du_num_node_alloc_bytes;
+ MR_Counter MR_tss_du_num_arg_lookups;
+ MR_Counter MR_tss_du_num_exist_lookups;
+
+ MR_Counter MR_tss_start_num_allocs;
+ MR_Counter MR_tss_start_num_alloc_bytes;
+};
+
+struct MR_TableStats_Struct {
+ MR_Counter MR_ts_num_lookups;
+ MR_Counter MR_ts_num_lookups_is_dupl;
+ /*
+ ** The number of steps is given by MR_pt_num_inputs for the call table
+ ** and MR_pt_num_outputs for the answer table.
+ */
+ MR_TableStepStats *MR_ts_steps;
};
-#define MR_copy_table_step_stats(prev, cur) \
- do { \
- prev->MR_tss_num_allocs = cur->MR_tss_num_allocs; \
- prev->MR_tss_num_inserts = cur->MR_tss_num_inserts; \
- prev->MR_tss_num_lookups = cur->MR_tss_num_lookups; \
- prev->MR_tss_num_insert_probes = \
- cur->MR_tss_num_insert_probes; \
- prev->MR_tss_num_lookup_probes = \
- cur->MR_tss_num_lookup_probes; \
- prev->MR_tss_num_resizes = cur->MR_tss_num_resizes; \
- prev->MR_tss_num_resizes_old_entries = \
- cur->MR_tss_num_resizes_old_entries; \
- prev->MR_tss_num_resizes_new_entries = \
- cur->MR_tss_num_resizes_new_entries; \
- } while (0)
+#define MR_TABLE_CALL_TABLE 0
+#define MR_TABLE_ANSWER_TABLE 1
+
+#define MR_TABLE_STATS_CURR 0
+#define MR_TABLE_STATS_PREV 1
+
+struct MR_TableStepDesc_Struct {
+ MR_ConstString MR_tsd_var_name;
+ MR_TableTrieStep MR_tsd_trie_step;
+ MR_Integer MR_tsd_trie_enum_param;
+};
struct MR_ProcTableInfo_Struct {
MR_TableType MR_pt_table_type;
int MR_pt_num_inputs;
int MR_pt_num_outputs;
int MR_pt_has_answer_table;
- const MR_TableTrieStep *MR_pt_input_steps;
- const MR_Integer *MR_pt_input_enum_params;
- const MR_TableTrieStep *MR_pt_output_steps;
- const MR_Integer *MR_pt_output_enum_params;
const MR_PseudoTypeInfo *MR_pt_ptis;
const MR_TypeParamLocns *MR_pt_type_params;
MR_TableNode MR_pt_tablenode;
- MR_Counter MR_pt_call_table_lookups;
- MR_Counter MR_pt_call_table_not_dupl;
- MR_TableStepStats *MR_pt_call_table_stats;
- MR_Counter MR_pt_prev_call_table_lookups;
- MR_Counter MR_pt_prev_call_table_not_dupl;
- MR_TableStepStats *MR_pt_prev_call_table_stats;
-
- MR_Counter MR_pt_answer_table_lookups;
- MR_Counter MR_pt_answer_table_not_dupl;
- MR_TableStepStats *MR_pt_answer_table_stats;
- MR_Counter MR_pt_prev_answer_table_lookups;
- MR_Counter MR_pt_prev_answer_table_not_dupl;
- MR_TableStepStats *MR_pt_prev_answer_table_stats;
+ /*
+ ** The index should be either MR_TABLE_CALL_TABLE or
+ ** MR_TABLE_ANSWER_TABLE. The size of the pointed-to array is
+ ** MR_pt_num_inputs for MR_TABLE_CALL_TABLE and MR_pt_num_outputs
+ ** for MR_TABLE_ANSWER_TABLE.
+ */
+ const MR_TableStepDesc *MR_pt_steps_desc[2];
+
+ /*
+ ** The first index should be either MR_TABLE_CALL_TABLE or
+ ** MR_TABLE_ANSWER_TABLE, while the second index should be either
+ ** MR_TABLE_STATS_CURR or MR_TABLE_STATS_PREV.
+ */
+ MR_TableStats MR_pt_stats[2][2];
MR_Unsigned MR_pt_size_limit;
MR_TrieNode *MR_pt_call_table_tips;
@@ -373,18 +403,24 @@
MR_Word key);
/*
-** This function assumes that the table is a statically sized array,
+** These functions assume that the table is a statically sized array,
** with the index ranging from 0 to range - 1.
*/
-extern MR_TrieNode MR_int_fix_index_lookup_or_add(MR_TrieNode table,
+extern MR_TrieNode MR_int_fix_index_enum_lookup_or_add(MR_TrieNode table,
+ MR_Integer range, MR_Integer key);
+extern MR_TrieNode MR_int_fix_index_enum_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Integer range, MR_Integer key);
+
+extern MR_TrieNode MR_int_fix_index_du_lookup_or_add(MR_TrieNode table,
MR_Integer range, MR_Integer key);
-extern MR_TrieNode MR_int_fix_index_lookup_or_add_stats(
+extern MR_TrieNode MR_int_fix_index_du_lookup_or_add_stats(
MR_TableStepStats *stats, MR_TrieNode table,
MR_Integer range, MR_Integer key);
/*
-** This function assumes that the table is an expandable array,
+** These functions assume that the table is an expandable array,
** with the smallest valid index value being start.
*/
@@ -395,7 +431,7 @@
MR_Integer start, MR_Integer key);
/*
-** This function tables type_infos in a hash table.
+** These functions table type_infos in a hash table.
*/
extern MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode table,
@@ -405,7 +441,7 @@
MR_TypeInfo type_info);
/*
-** This function tables typeclass_infos in a hash table.
+** These functions table typeclass_infos in a hash table.
*/
extern MR_TrieNode MR_type_class_info_lookup_or_add(MR_TrieNode table,
@@ -415,7 +451,7 @@
MR_Word *type_class_info);
/*
-** This function tables values of arbitrary types; the form of the data
+** These functions table values of arbitrary types; the form of the data
** structure depends on the actual type of the value. The tabling is done
** by tabling all the function symbols of the value; unlike
** MR_word_hash_lookup, this function *does* guarantee that all duplicates
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_macros.h,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_tabling_macros.h
--- runtime/mercury_tabling_macros.h 15 Aug 2007 01:35:02 -0000 1.16
+++ runtime/mercury_tabling_macros.h 31 Oct 2007 02:52:21 -0000
@@ -37,18 +37,18 @@
#define MR_RAW_TABLE_ANY_ADDR_STATS(stats, table, type_info, value) \
MR_word_hash_lookup_or_add_stats((stats), (table), (value))
-#define MR_RAW_TABLE_TAG(table, tag) \
- MR_int_fix_index_lookup_or_add((table), 1 << MR_TAGBITS, (tag))
-
-#define MR_RAW_TABLE_TAG_STATS(stats, table, tag) \
- MR_int_fix_index_lookup_or_add_stats((stats), (table), \
- 1 << MR_TAGBITS, (tag))
-
#define MR_RAW_TABLE_ENUM(table, range, value) \
- MR_int_fix_index_lookup_or_add((table), (range), (value))
+ MR_int_fix_index_enum_lookup_or_add((table), (range), (value))
#define MR_RAW_TABLE_ENUM_STATS(stats, table, range, value) \
- MR_int_fix_index_lookup_or_add_stats((stats), (table), \
+ MR_int_fix_index_enum_lookup_or_add_stats((stats), (table), \
+ (range), (value))
+
+#define MR_RAW_TABLE_DU(table, range, value) \
+ MR_int_fix_index_du_lookup_or_add((table), (range), (value))
+
+#define MR_RAW_TABLE_DU_STATS(stats, table, range, value) \
+ MR_int_fix_index_du_lookup_or_add_stats((stats), (table), \
(range), (value))
#define MR_RAW_TABLE_START_INT(table, start, value) \
@@ -136,25 +136,26 @@
} \
} while (0)
-#define MR_TABLE_TAG(stats, debug, back, t, t0, value) \
+#define MR_TABLE_ENUM(stats, debug, back, t, t0, count, value) \
do { \
if (stats != NULL) { \
- (t) = MR_RAW_TABLE_TAG_STATS((stats), (t0), (value)); \
+ (t) = MR_RAW_TABLE_ENUM_STATS((stats), (t0), (count), (value)); \
} else { \
- (t) = MR_RAW_TABLE_TAG((t0), (value)); \
+ (t) = MR_RAW_TABLE_ENUM((t0), (count), (value)); \
} \
if (debug && MR_tabledebug) { \
- printf("TABLE %p: tag %d => %p\n", \
- (t0), (value), (t)) \
+ printf("TABLE %p: enum %ld of %ld => %p\n", \
+ (t0), (long) (value), (long) (count), (t)); \
} \
} while (0)
-#define MR_TABLE_ENUM(stats, debug, back, t, t0, count, value) \
+#define MR_TABLE_DU(stats, debug, back, t, t0, count, value) \
do { \
if (stats != NULL) { \
- (t) = MR_RAW_TABLE_ENUM_STATS((stats), (t0), (count), (value)); \
+ (t) = MR_RAW_TABLE_DU_STATS((stats), (t0), (count), \
+ (value)); \
} else { \
- (t) = MR_RAW_TABLE_ENUM((t0), (count), (value)); \
+ (t) = MR_RAW_TABLE_DU((t0), (count), (value)); \
} \
if (debug && MR_tabledebug) { \
printf("TABLE %p: enum %ld of %ld => %p\n", \
Index: runtime/mercury_tabling_stats_defs.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_stats_defs.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_tabling_stats_defs.h
--- runtime/mercury_tabling_stats_defs.h 8 Jun 2006 08:20:01 -0000 1.1
+++ runtime/mercury_tabling_stats_defs.h 16 Nov 2007 00:41:57 -0000
@@ -7,25 +7,33 @@
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
-#define DECLARE_PROBE_COUNT MR_Integer probe_count = 0;
-#define record_probe_count() do { probe_count++; } while (0)
-#define record_lookup_count() \
+#define MR_TABLE_DECLARE_KEY_COMPARE_COUNT \
+ MR_Integer key_compare_count = 0;
+#define MR_table_record_hash_key_compare_count() \
do { \
- stats->MR_tss_num_lookup_probes += probe_count; \
- stats->MR_tss_num_lookups++; \
+ key_compare_count++; \
} while (0)
-#define record_insert_count() \
+#define MR_table_record_hash_dupl_count() \
do { \
- stats->MR_tss_num_insert_probes += probe_count; \
- stats->MR_tss_num_inserts++; \
+ stats->MR_tss_hash_num_key_compares_dupl += key_compare_count; \
} while (0)
-#define record_resize_count(old, new) \
+#define MR_table_record_hash_not_dupl_count() \
do { \
- stats->MR_tss_num_resizes++; \
- stats->MR_tss_num_resizes_old_entries += (old); \
- stats->MR_tss_num_resizes_new_entries += (new); \
+ stats->MR_tss_hash_num_key_compares_not_dupl += key_compare_count;\
} while (0)
-#define record_alloc_count() \
+#define MR_table_record_hash_resize_count(old, new) \
do { \
- stats->MR_tss_num_allocs++; \
+ stats->MR_tss_hash_num_resizes++; \
+ stats->MR_tss_hash_resize_old_entries += (old); \
+ stats->MR_tss_hash_resize_new_entries += (new); \
+ } while (0)
+#define MR_table_record_hash_table_alloc_count(numbytes) \
+ do { \
+ stats->MR_tss_hash_num_table_allocs++; \
+ stats->MR_tss_hash_num_table_alloc_bytes += (numbytes); \
+ } while (0)
+#define MR_table_record_hash_links_alloc_count(numbytes) \
+ do { \
+ stats->MR_tss_hash_num_link_chunk_allocs++; \
+ stats->MR_tss_hash_num_link_chunk_alloc_bytes += (numbytes); \
} while (0)
Index: runtime/mercury_tabling_stats_nodefs.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_stats_nodefs.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_tabling_stats_nodefs.h
--- runtime/mercury_tabling_stats_nodefs.h 8 Jun 2006 08:20:01 -0000 1.1
+++ runtime/mercury_tabling_stats_nodefs.h 14 Nov 2007 02:53:04 -0000
@@ -7,9 +7,10 @@
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
-#define DECLARE_PROBE_COUNT
-#define record_probe_count() ((void) 0)
-#define record_lookup_count() ((void) 0)
-#define record_insert_count() ((void) 0)
-#define record_resize_count(old, new) ((void) 0)
-#define record_alloc_count() ((void) 0)
+#define MR_TABLE_DECLARE_KEY_COMPARE_COUNT
+#define MR_table_record_hash_key_compare_count() ((void) 0)
+#define MR_table_record_hash_dupl_count() ((void) 0)
+#define MR_table_record_hash_not_dupl_count() ((void) 0)
+#define MR_table_record_hash_resize_count(old, new) ((void) 0)
+#define MR_table_record_hash_table_alloc_count(numbytes) ((void) 0)
+#define MR_table_record_hash_links_alloc_count(numbytes) ((void) 0)
Index: runtime/mercury_tabling_stats_undefs.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_stats_undefs.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_tabling_stats_undefs.h
--- runtime/mercury_tabling_stats_undefs.h 8 Jun 2006 08:20:01 -0000 1.1
+++ runtime/mercury_tabling_stats_undefs.h 5 Nov 2007 05:57:08 -0000
@@ -7,9 +7,10 @@
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
-#undef DECLARE_PROBE_COUNT
-#undef record_probe_count
-#undef record_lookup_count
-#undef record_insert_count
-#undef record_resize_count
-#undef record_alloc_count
+#undef MR_TABLE_DECLARE_KEY_COMPARE_COUNT
+#undef MR_table_record_hash_key_compare_count
+#undef MR_table_record_hash_dupl_count
+#undef MR_table_record_hash_not_dupl_count
+#undef MR_table_record_hash_resize_count
+#undef MR_table_record_hash_table_alloc_count
+#undef MR_table_record_hash_links_alloc_count
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_types.h,v
retrieving revision 1.54
diff -u -b -r1.54 mercury_types.h
--- runtime/mercury_types.h 20 Dec 2007 07:43:17 -0000 1.54
+++ runtime/mercury_types.h 20 Dec 2007 07:55:00 -0000
@@ -292,6 +292,8 @@
typedef MR_Generator *MR_GeneratorPtr;
typedef struct MR_TableStepStats_Struct MR_TableStepStats;
+typedef struct MR_TableStats_Struct MR_TableStats;
+typedef struct MR_TableStepDesc_Struct MR_TableStepDesc;
typedef struct MR_ProcTableInfo_Struct MR_ProcTableInfo;
typedef MR_ProcTableInfo *MR_ProcTableInfoPtr;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.50
diff -u -b -r1.50 Mmakefile
--- tests/tabling/Mmakefile 16 Nov 2007 03:44:54 -0000 1.50
+++ tests/tabling/Mmakefile 31 Dec 2007 07:27:01 -0000
@@ -16,6 +16,7 @@
fib \
fib_float \
fib_list \
+ fib_stats \
fib_string \
loopcheck_no_loop \
loopcheck_nondet_no_loop \
@@ -42,7 +43,8 @@
endif
NONLOOP_SPECIFIED_PROGS0 = \
- specified
+ specified \
+ specified_stats
# The above test uses the '--allow-table-reset' option which is not
# implemented for the MLDS backend.
Index: tests/tabling/fib.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/fib.m,v
retrieving revision 1.5
diff -u -b -r1.5 fib.m
--- tests/tabling/fib.m 31 May 2004 04:13:25 -0000 1.5
+++ tests/tabling/fib.m 22 Oct 2007 05:04:46 -0000
@@ -1,3 +1,5 @@
+% vim: ts=4 sw=4 et ft=mercury
+
:- module fib.
:- interface.
@@ -17,12 +19,15 @@
perform_trials(N, !IO) :-
trial(N, Time, MTime),
- % io__write_int(N, !IO),
- % io__write_string(": ", !IO),
- % io__write_int(Time, !IO),
- % io__write_string("ms vs ", !IO),
- % io__write_int(MTime, !IO),
- % io__write_string("ms\n", !IO),
+ trace [compiletime(flag("progress")), io(!S)] (
+ io.write_string("trial ", !S),
+ io.write_int(N, !S),
+ io.write_string(": ", !S),
+ io.write_int(Time, !S),
+ io.write_string("ms nonmemoed vs ", !S),
+ io.write_int(MTime, !S),
+ io.write_string("ms memoed\n", !S)
+ ),
(
(
Time > 10 * MTime,
@@ -32,11 +37,11 @@
MTime < 1 % while tabled takes at most 1 ms
)
->
- io__write_string("tabling works\n", !IO)
+ io.write_string("tabling works\n", !IO)
;
Time > 10000 % Untabled takes at least 10 seconds
->
- io__write_string("tabling does not appear to work\n", !IO)
+ io.write_string("tabling does not appear to work\n", !IO)
;
% We couldn't get a measurable result with N,
% and it looks like we can afford a bigger trial
Index: tests/tabling/fib_stats.exp
===================================================================
RCS file: tests/tabling/fib_stats.exp
diff -N tests/tabling/fib_stats.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/fib_stats.exp 31 Dec 2007 07:28:00 -0000
@@ -0,0 +1,115 @@
+fib(1): 1
+fib(2): 2
+fib(3): 3
+fib(4): 5
+fib(5): 8
+fib(6): 13
+fib(7): 21
+fib(8): 34
+fib(9): 55
+fib(10): 89
+
+Previous call table for mfib, test 1 to 10:
+number of lookups: 0
+
+Current call table for mfib, test 1 to 10:
+number of lookups: 28
+number of successful lookups (old calls): 17 (60.71%)
+number of unsuccessful lookups (new calls): 11 (39.29%)
+statistics for the individual steps:
+
+step 1, variable N: hash table
+ number of lookups: 28
+ number of successful lookups: 17 (60.71%)
+ number of unsuccessful lookups: 11 (39.29%)
+ number of hash table allocations: 1
+ number of bytes allocated for hash tables: 536
+ number of bulk hash link allocations: 1
+ number of bytes allocated for hash links: 3,080
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 17
+ number of hash table resizes: 0
+
+Call table difference (curr - prev) for mfib, test 1 to 10:
+number of lookups: 28
+number of successful lookups (old calls): 17 (60.71%)
+number of unsuccessful lookups (new calls): 11 (39.29%)
+statistics for the individual steps:
+
+step 1, variable N: hash table
+ number of lookups: 28
+ number of successful lookups: 17 (60.71%)
+ number of unsuccessful lookups: 11 (39.29%)
+ number of hash table allocations: 1
+ number of bytes allocated for hash tables: 536
+ number of bulk hash link allocations: 1
+ number of bytes allocated for hash links: 3,080
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 17
+ number of hash table resizes: 0
+
+fib(11): 144
+fib(12): 233
+fib(13): 377
+fib(14): 610
+fib(15): 987
+fib(16): 1597
+fib(17): 2584
+fib(18): 4181
+fib(19): 6765
+fib(20): 10946
+
+Previous call table for mfib, test 11 to 20:
+number of lookups: 28
+number of successful lookups (old calls): 17 (60.71%)
+number of unsuccessful lookups (new calls): 11 (39.29%)
+statistics for the individual steps:
+
+step 1, variable N: hash table
+ number of lookups: 28
+ number of successful lookups: 17 (60.71%)
+ number of unsuccessful lookups: 11 (39.29%)
+ number of hash table allocations: 1
+ number of bytes allocated for hash tables: 536
+ number of bulk hash link allocations: 1
+ number of bytes allocated for hash links: 3,080
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 17
+ number of hash table resizes: 0
+
+Current call table for mfib, test 11 to 20:
+number of lookups: 58
+number of successful lookups (old calls): 37 (63.79%)
+number of unsuccessful lookups (new calls): 21 (36.21%)
+statistics for the individual steps:
+
+step 1, variable N: hash table
+ number of lookups: 58
+ number of successful lookups: 37 (63.79%)
+ number of unsuccessful lookups: 21 (36.21%)
+ number of hash table allocations: 1
+ number of bytes allocated for hash tables: 536
+ number of bulk hash link allocations: 1
+ number of bytes allocated for hash links: 3,080
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 37
+ number of hash table resizes: 0
+
+Call table difference (curr - prev) for mfib, test 11 to 20:
+number of lookups: 30
+number of successful lookups (old calls): 20 (66.67%)
+number of unsuccessful lookups (new calls): 10 (33.33%)
+statistics for the individual steps:
+
+step 1, variable N: hash table
+ number of lookups: 30
+ number of successful lookups: 20 (66.67%)
+ number of unsuccessful lookups: 10 (33.33%)
+ number of hash table allocations: 0
+ number of bytes allocated for hash tables: 0
+ number of bulk hash link allocations: 0
+ number of bytes allocated for hash links: 0
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 20
+ number of hash table resizes: 0
+
Index: tests/tabling/fib_stats.m
===================================================================
RCS file: tests/tabling/fib_stats.m
diff -N tests/tabling/fib_stats.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/fib_stats.m 5 Nov 2007 06:26:02 -0000
@@ -0,0 +1,68 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module fib_stats.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+:- import_module table_statistics.
+
+main(!IO) :-
+ test(1, 10, !IO),
+ test(11, 20, !IO).
+
+:- pred test(int::in, int::in, io::di, io::uo) is det.
+
+test(Cur, Max, !IO) :-
+ test_loop(Cur, Max, !IO),
+ table_statistics_for_mfib_2(Info, !IO),
+ Info = proc_table_statistics(CallTableStatsCurPrev,
+ _AnswerTableStatsCurPrev),
+ CallTableStatsCurPrev = table_stats_curr_prev(CallTableStatsCur,
+ CallTableStatsPrev),
+ io.nl(!IO),
+ io.format("Previous call table for mfib, test %d to %d:\n",
+ [i(Cur), i(Max)], !IO),
+ write_table_stats(CallTableStatsPrev, !IO),
+ io.nl(!IO),
+ io.format("Current call table for mfib, test %d to %d:\n",
+ [i(Cur), i(Max)], !IO),
+ write_table_stats(CallTableStatsCur, !IO),
+ io.nl(!IO),
+ io.format("Call table difference (curr - prev) for mfib, test %d to %d:\n",
+ [i(Cur), i(Max)], !IO),
+ CallTableStatsDiff =
+ table_stats_difference(CallTableStatsCur, CallTableStatsPrev),
+ write_table_stats(CallTableStatsDiff, !IO),
+ io.nl(!IO).
+
+:- pred test_loop(int::in, int::in, io::di, io::uo) is det.
+
+test_loop(Cur, Max, !IO) :-
+ ( Cur =< Max ->
+ mfib(Cur, Fib),
+ io.format("fib(%d): %d\n", [i(Cur), i(Fib)], !IO),
+ test_loop(Cur + 1, Max, !IO)
+ ;
+ true
+ ).
+
+:- pred mfib(int::in, int::out) is det.
+:- pragma memo(mfib/2, [statistics]).
+
+mfib(N, F) :-
+ ( N < 2 ->
+ F = 1
+ ;
+ mfib(N - 1, F1),
+ mfib(N - 2, F2),
+ F = F1 + F2
+ ).
Index: tests/tabling/specified.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/specified.m,v
retrieving revision 1.3
diff -u -b -r1.3 specified.m
--- tests/tabling/specified.m 8 Jun 2006 08:20:14 -0000 1.3
+++ tests/tabling/specified.m 5 Nov 2007 06:43:59 -0000
@@ -1,6 +1,7 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
+%
% This test case is designed to test the functionality of tabling pragmas
% that explicitly specify how each input argument should be looked up in the
% call table:
@@ -21,16 +22,14 @@
:- import_module benchmarking.
:- import_module int.
:- import_module list.
-:- import_module require.
:- import_module pair.
+:- import_module require.
+:- import_module string.
main(!IO) :-
perform_trials(aplp_vs_vplp, [1, 4], 14, 3, 0, 0, !IO),
perform_trials(apli_vs_vpli, [1, 4], 14, 3, 0, 0, !IO),
perform_trials(vvll_vs_vpll, [4, 4, 4], 444, 30, 0, 0, !IO).
- % table_statistics_for_vv_ll_fib_3(Stats, !IO),
- % io.write(Stats, !IO),
- % io.nl(!IO).
:- type trial_type
---> aplp_vs_vplp
@@ -42,14 +41,6 @@
perform_trials(TrialType, ListN, IntN, Incr, NumDouble0, NumTrials0, !IO) :-
trial(TrialType, ListN, IntN, Time, MTime, !IO),
- % io__write(TrialType, !IO),
- % io__write_string(" ", !IO),
- % io__write(IntN, !IO),
- % io__write_string(": ", !IO),
- % io__write_int(Time, !IO),
- % io__write_string("ms vs ", !IO),
- % io__write_int(MTime, !IO),
- % io__write_string("ms\n", !IO),
(
MTime > 10,
Time > MTime * 2
@@ -72,8 +63,8 @@
% for the last ten trials.
)
->
- io__write(TrialType, !IO),
- io__write_string(": tabling works\n", !IO)
+ io.write(TrialType, !IO),
+ io.write_string(": tabling works\n", !IO)
;
(
Time > 10000 % "should be slower" takes at least 10 seconds
@@ -81,18 +72,18 @@
NumTrials0 > 1000
)
->
- io__write(TrialType, !IO),
- io__write_string(": tabling does not appear to work\n", !IO)
+ io.write(TrialType, !IO),
+ io.write_string(": tabling does not appear to work\n", !IO)
;
% We couldn't get a measurable result with N,
- % and it looks like we can afford a bigger trial
+ % and it looks like we can afford a bigger trial.
perform_trials(TrialType,
add_digits(ListN, num_to_digits(Incr)), IntN + Incr, Incr,
NumDouble, NumTrials0 + 1, !IO)
).
-:- pred trial(trial_type::in, list(int)::in, int::in, int::out, int::out,
- io::di, io::uo) is cc_multi.
+:- pred trial(trial_type::in, list(int)::in, int::in,
+ int::out, int::out, io::di, io::uo) is cc_multi.
trial(TrialType, ListN, IntN, Time, MTime, !IO) :-
(
@@ -278,7 +269,7 @@
:- func digits_to_num(list(int)) = int.
digits_to_num(Digits) = Num :-
- list__reverse(Digits, RevDigits),
+ list.reverse(Digits, RevDigits),
Num = digits_to_num_2(RevDigits).
:- func digits_to_num_2(list(int)) = int.
@@ -295,5 +286,5 @@
;
Last = Int mod 10,
Rest = Int // 10,
- list__append(num_to_digits(Rest), [Last], Digits)
+ list.append(num_to_digits(Rest), [Last], Digits)
).
Index: tests/tabling/specified_stats.exp
===================================================================
RCS file: tests/tabling/specified_stats.exp
diff -N tests/tabling/specified_stats.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/specified_stats.exp 31 Dec 2007 07:28:46 -0000
@@ -0,0 +1,187 @@
+
+call table statistics for ap_lp_fib
+number of lookups: 1,219
+number of successful lookups (old calls): 0 (0.00%)
+number of unsuccessful lookups (new calls): 1,219 (100.00%)
+statistics for the individual steps:
+
+step 1, variable TypeInfo_for_T: hash table
+ number of lookups: 1,219
+ number of successful lookups: 1,218 (99.92%)
+ number of unsuccessful lookups: 1 (0.08%)
+ number of hash table allocations: 2
+ number of bytes allocated for hash tables: 1,072
+ number of bulk hash link allocations: 2
+ number of bytes allocated for hash links: 6,160
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 2,436
+ number of hash table resizes: 0
+
+step 2, variable N: hash table
+ number of lookups: 1,219
+ number of successful lookups: 0 (0.00%)
+ number of unsuccessful lookups: 1,219 (100.00%)
+ number of hash table allocations: 1
+ number of bytes allocated for hash tables: 536
+ number of bulk hash link allocations: 5
+ number of bytes allocated for hash links: 15,400
+ number of key compares when unsuccessful: 448
+ number of key compares when successful: 0
+ number of hash table resizes: 4
+ number of old entries in resizes: 1,914
+ number of new entries in resizes: 3,840
+
+step 3, variable Dummy: none
+ number of lookups: 0
+
+
+call table statistics for vp_lp_fib
+number of lookups: 27
+number of successful lookups (old calls): 12 (44.44%)
+number of unsuccessful lookups (new calls): 15 (55.56%)
+statistics for the individual steps:
+
+step 1, variable TypeInfo_for_T: hash table
+ number of lookups: 27
+ number of successful lookups: 26 (96.30%)
+ number of unsuccessful lookups: 1 (3.70%)
+ number of hash table allocations: 2
+ number of bytes allocated for hash tables: 1,072
+ number of bulk hash link allocations: 2
+ number of bytes allocated for hash links: 6,160
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 52
+ number of hash table resizes: 0
+
+step 2, variable N: discriminated union nested trie
+ number of lookups: 27
+ number of successful lookups: 12 (44.44%)
+ number of unsuccessful lookups: 15 (55.56%)
+ number of du functor node allocations: 16
+ number of bytes allocated for du functors: 128
+ number of du functor argument lookups: 70
+ number of hash table allocations: 2
+ number of bytes allocated for hash tables: 1,072
+ number of bulk hash link allocations: 2
+ number of bytes allocated for hash links: 6,160
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 20
+ number of hash table resizes: 0
+
+step 3, variable Dummy: none
+ number of lookups: 0
+
+aplp_vs_vplp: tabling works
+
+call table statistics for ap_li_fib
+number of lookups: 1,219
+number of successful lookups (old calls): 0 (0.00%)
+number of unsuccessful lookups (new calls): 1,219 (100.00%)
+statistics for the individual steps:
+
+step 1, variable N: hash table
+ number of lookups: 1,219
+ number of successful lookups: 0 (0.00%)
+ number of unsuccessful lookups: 1,219 (100.00%)
+ number of hash table allocations: 1
+ number of bytes allocated for hash tables: 536
+ number of bulk hash link allocations: 5
+ number of bytes allocated for hash links: 15,400
+ number of key compares when unsuccessful: 481
+ number of key compares when successful: 0
+ number of hash table resizes: 4
+ number of old entries in resizes: 1,914
+ number of new entries in resizes: 3,840
+
+step 2, variable CopyN: none
+ number of lookups: 0
+
+
+call table statistics for vp_li_fib
+number of lookups: 27
+number of successful lookups (old calls): 12 (44.44%)
+number of unsuccessful lookups (new calls): 15 (55.56%)
+statistics for the individual steps:
+
+step 1, variable N: discriminated union nested trie
+ number of lookups: 27
+ number of successful lookups: 12 (44.44%)
+ number of unsuccessful lookups: 15 (55.56%)
+ number of du functor node allocations: 16
+ number of bytes allocated for du functors: 128
+ number of du functor argument lookups: 70
+ number of hash table allocations: 2
+ number of bytes allocated for hash tables: 1,072
+ number of bulk hash link allocations: 2
+ number of bytes allocated for hash links: 6,160
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 20
+ number of hash table resizes: 0
+
+step 2, variable CopyN: none
+ number of lookups: 0
+
+apli_vs_vpli: tabling works
+
+call table statistics for vv_ll_fib
+number of lookups: 887
+number of successful lookups (old calls): 442 (49.83%)
+number of unsuccessful lookups (new calls): 445 (50.17%)
+statistics for the individual steps:
+
+step 1, variable N: discriminated union nested trie
+ number of lookups: 887
+ number of successful lookups: 442 (49.83%)
+ number of unsuccessful lookups: 445 (50.17%)
+ number of du functor node allocations: 446
+ number of bytes allocated for du functors: 3,568
+ number of du functor argument lookups: 4,886
+ number of hash table allocations: 45
+ number of bytes allocated for hash tables: 24,120
+ number of bulk hash link allocations: 45
+ number of bytes allocated for hash links: 138,600
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 1,998
+ number of hash table resizes: 0
+
+step 2, variable CopyN: discriminated union nested trie
+ number of lookups: 887
+ number of successful lookups: 442 (49.83%)
+ number of unsuccessful lookups: 445 (50.17%)
+ number of du functor node allocations: 1,670
+ number of bytes allocated for du functors: 13,360
+ number of du functor argument lookups: 4,886
+ number of hash table allocations: 1,225
+ number of bytes allocated for hash tables: 656,600
+ number of bulk hash link allocations: 1,225
+ number of bytes allocated for hash links: 3,773,000
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 1,218
+ number of hash table resizes: 0
+
+
+call table statistics for vp_ll_fib
+number of lookups: 887
+number of successful lookups (old calls): 442 (49.83%)
+number of unsuccessful lookups (new calls): 445 (50.17%)
+statistics for the individual steps:
+
+step 1, variable N: discriminated union nested trie
+ number of lookups: 887
+ number of successful lookups: 442 (49.83%)
+ number of unsuccessful lookups: 445 (50.17%)
+ number of du functor node allocations: 446
+ number of bytes allocated for du functors: 3,568
+ number of du functor argument lookups: 4,886
+ number of hash table allocations: 45
+ number of bytes allocated for hash tables: 24,120
+ number of bulk hash link allocations: 45
+ number of bytes allocated for hash links: 138,600
+ number of key compares when unsuccessful: 0
+ number of key compares when successful: 1,998
+ number of hash table resizes: 0
+
+step 2, variable CopyN: none
+ number of lookups: 0
+
+vvll_vs_vpll: tabling works
Index: tests/tabling/specified_stats.m
===================================================================
RCS file: tests/tabling/specified_stats.m
diff -N tests/tabling/specified_stats.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/specified_stats.m 5 Nov 2007 06:44:23 -0000
@@ -0,0 +1,332 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+%
+% This is a version of specified.m designed to test the code for collecting
+% and printing tabling statistics.
+
+:- module specified_stats.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module assoc_list.
+:- import_module benchmarking.
+:- import_module int.
+:- import_module list.
+:- import_module maybe.
+:- import_module pair.
+:- import_module require.
+:- import_module string.
+:- import_module table_statistics.
+
+main(!IO) :-
+ perform_trials(aplp_vs_vplp, [1, 4], 14, 3, 0, 0, !IO),
+ perform_trials(apli_vs_vpli, [1, 4], 14, 3, 0, 0, !IO),
+ perform_trials(vvll_vs_vpll, [4, 4, 4], 444, 30, 0, 0, !IO).
+
+:- type trial_type
+ ---> aplp_vs_vplp
+ ; apli_vs_vpli
+ ; vvll_vs_vpll.
+
+:- pred perform_trials(trial_type::in, list(int)::in, int::in, int::in,
+ int::in, int::in, io::di, io::uo) is cc_multi.
+
+perform_trials(TrialType, ListN, IntN, Incr, NumDouble0, NumTrials0, !IO) :-
+ trial(TrialType, NumTrials0, ListN, IntN, Time, MTime, !IO),
+ (
+ MTime > 10,
+ Time > MTime * 2
+ ->
+ NumDouble = NumDouble0 + 1
+ ;
+ NumDouble = 0
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % "should be slower" version takes ten times as long
+ ;
+ Time > 100, % "should be slower" version takes at least 100 ms
+ MTime < 1 % while "should be faster" version takes at most 1 ms
+ ;
+ NumDouble >= 10
+ % The "should be faster" version has been at least
+ % double the speed of the "should be slower" version
+ % for the last ten trials.
+ )
+ ->
+ io.write(TrialType, !IO),
+ io.write_string(": tabling works\n", !IO)
+ ;
+ (
+ Time > 10000 % "should be slower" takes at least 10 seconds
+ ;
+ NumTrials0 > 1000
+ )
+ ->
+ io.write(TrialType, !IO),
+ io.write_string(": tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial.
+ perform_trials(TrialType,
+ add_digits(ListN, num_to_digits(Incr)), IntN + Incr, Incr,
+ NumDouble, NumTrials0 + 1, !IO)
+ ).
+
+:- pred trial(trial_type::in, int::in, list(int)::in, int::in,
+ int::out, int::out, io::di, io::uo) is cc_multi.
+
+trial(TrialType, TrialNum, ListN, IntN, Time, MTime, !IO) :-
+ (
+ TrialType = aplp_vs_vplp,
+ benchmark_det(ap_lp_fib_test, ListN - [42], Res, 1, Time),
+ benchmark_det(vp_lp_fib_test, ListN - [42], MRes, 1, MTime),
+
+ table_statistics_for_ap_lp_fib_3(AP_LP_ProcStats, !IO),
+ maybe_write_table_stats(TrialNum, "ap_lp_fib", AP_LP_ProcStats, !IO),
+
+ table_statistics_for_vp_lp_fib_3(VP_LP_ProcStats, !IO),
+ maybe_write_table_stats(TrialNum, "vp_lp_fib", VP_LP_ProcStats, !IO)
+ ;
+ TrialType = apli_vs_vpli,
+ benchmark_det(ap_li_fib_test, ListN - IntN, Res, 1, Time),
+ benchmark_det(vp_li_fib_test, ListN - IntN, MRes, 1, MTime),
+
+ table_statistics_for_ap_li_fib_3(AP_LI_ProcStats, !IO),
+ maybe_write_table_stats(TrialNum, "ap_li_fib", AP_LI_ProcStats, !IO),
+
+ table_statistics_for_vp_li_fib_3(VP_LI_ProcStats, !IO),
+ maybe_write_table_stats(TrialNum, "vp_li_fib", VP_LI_ProcStats, !IO)
+ ;
+ TrialType = vvll_vs_vpll,
+ table_reset_for_vv_ll_fib_3(!IO),
+ table_reset_for_vp_ll_fib_3(!IO),
+ benchmark_det(vv_ll_fib_test, ListN - ListN, Res, 1, Time),
+ benchmark_det(vp_ll_fib_test, ListN - ListN, MRes, 1, MTime),
+
+ table_statistics_for_vv_ll_fib_3(VV_LL_ProcStats, !IO),
+ maybe_write_table_stats(TrialNum, "vv_ll_fib", VV_LL_ProcStats, !IO),
+
+ table_statistics_for_vp_ll_fib_3(VP_LL_ProcStats, !IO),
+ maybe_write_table_stats(TrialNum, "vp_ll_fib", VP_LL_ProcStats, !IO)
+ ),
+ require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred maybe_write_table_stats(int::in, string::in, proc_table_statistics::in,
+ io::di, io::uo) is det.
+
+maybe_write_table_stats(TrialNum, PredName, ProcStats, !IO) :-
+ ( TrialNum = 0 ->
+ ProcStats =
+ proc_table_statistics(CallStatsCurPrev, MaybeAnswerStatsCurPrev),
+ CallStatsCurPrev = table_stats_curr_prev(CallStatsCur, _),
+ io.nl(!IO),
+ io.format("call table statistics for %s\n", [s(PredName)], !IO),
+ write_table_stats(CallStatsCur, !IO),
+ (
+ MaybeAnswerStatsCurPrev = no
+ ;
+ MaybeAnswerStatsCurPrev = yes(AnswerStatsCurPrev),
+ AnswerStatsCurPrev = table_stats_curr_prev(AnswerStatsCur, _),
+ io.nl(!IO),
+ io.format("answer table statistics for %s\n", [s(PredName)], !IO),
+ write_table_stats(AnswerStatsCur, !IO)
+ ),
+ io.nl(!IO)
+ ;
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ap_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
+
+ap_lp_fib_test(N - Dummy, F) :-
+ ap_lp_fib(N, Dummy, F).
+
+:- pred vp_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
+
+vp_lp_fib_test(N - Dummy, F) :-
+ vp_lp_fib(N, Dummy, F).
+
+:- pred ap_li_fib_test(pair(list(int), int)::in, list(int)::out) is det.
+
+ap_li_fib_test(N - CopyN, F) :-
+ ap_li_fib(N, CopyN, F).
+
+:- pred vp_li_fib_test(pair(list(int), int)::in, list(int)::out) is det.
+
+vp_li_fib_test(N - CopyN, F) :-
+ vp_li_fib(N, CopyN, F).
+
+:- pred vp_ll_fib_test(pair(list(int), list(int))::in, list(int)::out) is det.
+
+vp_ll_fib_test(N - CopyN, F) :-
+ vp_ll_fib(N, CopyN, F).
+
+:- pred vv_ll_fib_test(pair(list(int), list(int))::in, list(int)::out) is det.
+
+vv_ll_fib_test(N - CopyN, F) :-
+ vv_ll_fib(N, CopyN, F).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ap_lp_fib(list(int)::in, T::in, list(int)::out) is det.
+:- pragma memo(ap_lp_fib(in, in, out),
+ [allow_reset, statistics, specified([addr, promise_implied, output])]).
+
+ap_lp_fib(N, Dummy, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ F = num_to_digits(1)
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ ap_lp_fib(subtract_digits(N, One), Dummy, F1),
+ ap_lp_fib(subtract_digits(N, Two), Dummy, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_lp_fib(list(int)::in, T::in, list(int)::out) is det.
+:- pragma memo(vp_lp_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
+
+vp_lp_fib(N, Dummy, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ F = num_to_digits(1)
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_lp_fib(subtract_digits(N, One), Dummy, F1),
+ vp_lp_fib(subtract_digits(N, Two), Dummy, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred ap_li_fib(list(int)::in, int::in, list(int)::out) is det.
+:- pragma memo(ap_li_fib(in, in, out),
+ [allow_reset, statistics, specified([addr, promise_implied, output])]).
+
+ap_li_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = CopyN ->
+ F = num_to_digits(1)
+ ;
+ error("ap_li_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ ap_li_fib(subtract_digits(N, One), RawN - 1, F1),
+ ap_li_fib(subtract_digits(N, Two), RawN - 2, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_li_fib(list(int)::in, int::in, list(int)::out) is det.
+:- pragma memo(vp_li_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
+
+vp_li_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = CopyN ->
+ F = num_to_digits(1)
+ ;
+ error("vp_li_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_li_fib(subtract_digits(N, One), CopyN - 1, F1),
+ vp_li_fib(subtract_digits(N, Two), CopyN - 2, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
+:- pragma memo(vp_ll_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
+
+vp_ll_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = digits_to_num(CopyN) ->
+ F = num_to_digits(1)
+ ;
+ error("vp_ll_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_ll_fib(subtract_digits(N, One), subtract_digits(N, One), F1),
+ vp_ll_fib(subtract_digits(N, Two), subtract_digits(N, Two), F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vv_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
+:- pragma memo(vv_ll_fib/3,
+ [allow_reset, statistics, specified([value, value, output])]).
+
+vv_ll_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = digits_to_num(CopyN) ->
+ F = num_to_digits(1)
+ ;
+ error("vv_ll_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vv_ll_fib(subtract_digits(N, One), subtract_digits(N, One), F1),
+ vv_ll_fib(subtract_digits(N, Two), subtract_digits(N, Two), F2),
+ F = add_digits(F1, F2)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func add_digits(list(int), list(int)) = list(int).
+
+add_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) + digits_to_num(S2)).
+
+:- func mul_digits(list(int), list(int)) = list(int).
+
+mul_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) * digits_to_num(S2)).
+
+:- func subtract_digits(list(int), list(int)) = list(int).
+
+subtract_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) - digits_to_num(S2)).
+
+:- func digits_to_num(list(int)) = int.
+
+digits_to_num(Digits) = Num :-
+ list.reverse(Digits, RevDigits),
+ Num = digits_to_num_2(RevDigits).
+
+:- func digits_to_num_2(list(int)) = int.
+
+digits_to_num_2([]) = 0.
+digits_to_num_2([Last | Rest]) =
+ 10 * digits_to_num_2(Rest) + Last.
+
+:- func num_to_digits(int) = list(int).
+
+num_to_digits(Int) = Digits :-
+ ( Int < 10 ->
+ Digits = [Int]
+ ;
+ Last = Int mod 10,
+ Rest = Int // 10,
+ list.append(num_to_digits(Rest), [Last], Digits)
+ ).
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_cmd_developer.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_developer.c,v
retrieving revision 1.8
diff -u -b -r1.8 mercury_trace_cmd_developer.c
--- trace/mercury_trace_cmd_developer.c 2 Oct 2007 17:04:37 -0000 1.8
+++ trace/mercury_trace_cmd_developer.c 15 Nov 2007 02:28:29 -0000
@@ -745,6 +745,7 @@
MR_ProcSpec spec;
MR_ProcTableInfo *pt;
MR_TrieNode table_cur;
+ const MR_TableStepDesc *input_step_descs;
int num_inputs;
int filtered_num_inputs;
int cur_arg;
@@ -819,14 +820,15 @@
}
table_cur = &pt->MR_pt_tablenode;
+ input_step_descs = pt->MR_pt_steps_desc[MR_TABLE_CALL_TABLE];
for (cur_arg = 0, filtered_cur_arg = 0; cur_arg < num_inputs; cur_arg++) {
- switch (pt->MR_pt_input_steps[cur_arg]) {
+ switch (input_step_descs[cur_arg].MR_tsd_trie_step) {
case MR_TABLE_STEP_INT:
case MR_TABLE_STEP_FLOAT:
case MR_TABLE_STEP_STRING:
/* These are OK. */
call_table_args[filtered_cur_arg].MR_cta_step =
- pt->MR_pt_input_steps[filtered_cur_arg];
+ input_step_descs[cur_arg].MR_tsd_trie_step;
call_table_args[filtered_cur_arg].MR_cta_valid = MR_FALSE;
call_table_args[filtered_cur_arg].MR_cta_unfiltered_arg_num =
cur_arg;
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list