[m-rev.] for review: add mdb `dice' command
Ian MacLarty
maclarty at cs.mu.OZ.AU
Mon Feb 7 15:00:08 AEDT 2005
On Mon, Feb 07, 2005 at 12:58:58AM +1100, Julien Fischer wrote:
>
> On Sun, 6 Feb 2005, Ian MacLarty wrote:
>
> > For review by anyone.
> >
> > Estimated hours taken: 40
> > Branches: main
> >
> > Add mdb `dice' command which reads in a set of passing trace counts and a
> > failing trace count and prints a comparison table. The table can be sorted
> > by various metrics and is useful for finding parts of a program executed in
> > a failing run, but not in passing runs.
> >
> The log message should mention that this eventually intendted to be used
> as part of the declartive debugger.
>
Although the declarative debugger will use some of the code in
dice.m the `dice' mdb command is intended to be an independent feature.
So I don't think mentioning the declarative debugger is necessary or
relevant.
> > Index: browser/dice.m
> > ===================================================================
> > RCS file: browser/dice.m
> > diff -N browser/dice.m
> > --- /dev/null 1 Jan 1970 00:00:00 -0000
> > +++ browser/dice.m 6 Feb 2005 07:47:34 -0000
> > @@ -0,0 +1,626 @@
> > +%-----------------------------------------------------------------------------%
> > +% Copyright (C) 1999-2005 The University of Melbourne.
>
> You started work on this in 1999?
>
Fixed.
>
> > + % read_dice_to_string(PassFiles, FailFile, SortStr, N, DiceStr,
> > + % Problem, !IO).
> > + % Read the trace_counts in the list of files in the file named
> > + % PassFiles, interpretting them as passing slices; read the
> s/interpretting/interpreting/
>
> > + % trace_counts from the file FailFile, interpretting it as a failing
> And again here.
>
Fixed.
> > +
> > +bracket_int(X) = "(" ++ string.int_to_string_thousands(X) ++ ")".
> > +
> > +:- func suspicion_ratio(int, int) = float.
> > +
> > + % suspicion_ration gives an indication of how lightly a label is to
> s/suspicion_ration/suspicion_ratio/
> s/lightly/likely/
Fixed.
>
> > + % be buggy based on how many times it was executed in passing and
> > + % failing test runs.
> > + %
> > +suspicion_ratio(PassCount, FailCount) =
> > + % PassCount + FailCount should never be zero since if a label
> > + % isn't executed in any tests then it wouldn't be included in the dice.
> > + float(FailCount) / float(PassCount + FailCount).
> > +
> I suggest putting a check that PassCount + FailCount \= 0 there.
>
Do you mean it should fail if the denominator is zero? This should
never be the case since then the label wouldn't be included in
the dice. Or do you mean I should throw an exception if the denominator
is zero? Won't an exception get thrown anyway if I try to divide by
zero?
> > +:- func format_float(int, float) = string.
> > +
> > +format_float(DecimalPlaces, Flt) = string.format("%." ++
> > + int_to_string(DecimalPlaces) ++ "f", [f(Flt)]).
> > +
> You could write that more succinctly as:
>
> string.format("%.*f", [i(DecimalPlaces), f(Flt)])
>
Thanks.
> > + ;
> > + SpecialPredId = compare,
> > + Name = "__Compare__"
> > + ;
> > + SpecialPredId = initialise,
> > + Name = "__Initialise__"
> > + ),
> The module compiler/special_pred contains predicates for handling the
> names of special preds. I suggest moving the relevant bits into the
> mdbcomp library and using them here.
>
Okay. I've moved special_pred_description/2 from
compiler/special_pred.m to mdbcomp/prim_data.m, made it a function, and
used it in dice.m
> > + for (module_num = 0; module_num < num_modules; module_num++) {
> > + module = MR_module_infos[module_num];
> > + if (MR_streq(Module, module->MR_ml_name)) {
> > + num_files = module->MR_ml_filename_count;
> > + for (file_num = 0; file_num < num_files; file_num++) {
> > + file = module->MR_ml_module_file_layout[file_num];
> > + num_labels = file->MR_mfl_label_count;
> > + for (label_num = 0; label_num < num_labels; label_num++) {
> > + label = file->MR_mfl_label_layout[label_num];
> > + proc = label->MR_sll_entry;
> > + id = &proc->MR_sle_user;
> > + if (MR_streq(id->MR_user_name, Name) &&
> > + id->MR_user_arity == Arity &&
> > + id->MR_user_mode == ModeNo) {
> > + MR_TRACE_CALL_MERCURY(
> > + MR_MDB_same_path_port(
> > + (MR_String) MR_label_goal_path(label),
> > + label->MR_sll_port, PathPort, &are_same);
> > + );
> > + if (are_same) {
> > + SUCCESS_INDICATOR = MR_find_context(label,
> > + &filename, &LineNo);
> > + MR_TRACE_USE_HP(
> > + MR_make_aligned_string(FileName,
> > + (MR_String) filename);
> > + );
> > + goto end;
> > + }
> > + }
> > + }
> > + }
> > + }
> > + }
> > +
> The amount of nesting and lack of whitespace here make this block of
> code very difficult to understand. Would it be possible to factor some
> of this out into separate functions?
>
What do you mean by lack of whitespace? Where would you like to see
more whitespace?
> > +:- pred map6(pred(T, T1, T2, T3, T4, T5, T6), list(T), list(T1),
> > + list(T2), list(T3), list(T4), list(T5), list(T6)).
> > +:- mode map6(pred(in, out, out, out, out, out, out) is det, in, out, out,
> > + out, out, out, out) is det.
> > +
> > +map6(_, [], [], [], [], [], [], []).
> > +map6(P, [H | T], [H1 | T1], [H2 | T2], [H3 | T3], [H4 | T4], [H5 | T5],
> > + [H6 | T6]) :-
> > + P(H, H1, H2, H3, H4, H5, H6),
> > + dice.map6(P, T, T1, T2, T3, T4, T5, T6).
>
> You may want to consider adding that to the standard library.
>
Have done. Also added map4 and map5.
> > Index: doc/user_guide.texi
> > ===================================================================
> > RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
> > retrieving revision 1.416
> > diff -u -r1.416 user_guide.texi
> > --- doc/user_guide.texi 2 Feb 2005 02:59:06 -0000 1.416
> > +++ doc/user_guide.texi 6 Feb 2005 07:52:24 -0000
> > @@ -2722,90 +2722,6 @@
> > which were printed when control arrived at the event,
> > have since scrolled off the screen.
> > @sp 1
>
> ...
>
> > + at sp 1
> > + at item dice [-p at var{filename}] [-f at var{filename}] [-n at var{num}] [-s[pPfFsS]+] [-o @var{filename}]
> > + at kindex dice (mdb command)
> > +Display a program dice on the screen.
> > + at sp 1
> > +A dice is a comparison between some successful test runs of the program and a
> > +failing test run. Before using the @samp{dice} command one or more passing
> > +execution summaries and one failing execution summary should be generated.
> > +This can be done by compiling the program with deep tracing enabled (either by
> > +compiling in the .debug or .decldebug grades or with the @samp{--trace deep}
>
> The .decldebug grade is not currently documented.
>
Okay, I commented out the .decldebug bit.
> > +compiler option) and then running the program with the MERCURY_OPTIONS
> > +environment variable set to @samp{--trace-count}.
> > +This will generate a file called
> > + at samp{.mercury_trace_counts} which contains a summary of the program's execution
> > +(called a slice). Copy the generated slice to a new file for each test case,
> > +to end up with some passing slices, say @samp{pass1}, @samp{pass2},
> > + at samp{pass3}, etc. and a
> > +failing slice, say @samp{fail}.
> > + at sp 1
> > +Once one or more passing slices and a failing slice has been generated the
> s/has/have/
Okay.
>
> > + at samp{dice} command can be used to display a table of statistics comparing the
> > +passing test runs to the failing run. Each row in the table contains statistics
> > +about the execution of a seperate goal in the program. Six columns are
> s/seperate/separate/
>
Fixed.
> > +displayed:
> > + at sp 1
> > + at itemize @bullet
> > + at item @samp{Procedure}:
> > +The procedure in which the goal appears.
> > + at item @samp{Path/Port}:
> > +The goal path and/or port of the goal. For atomic goals, statistics about the
> > +CALL event and the corresponding EXIT, FAIL or EXCP event are displayed on
> > +seperate rows. For other types of goals the goal path is displayed, except for
> s/seperate/separate/
>
Fixed.
I've added the following to the CVS log message:
compiler/hlds_error_util.m
compiler/hlds_out.m
compiler/special_pred.m
mdbcomp/prim_data.m
Move special_pred_description from compiler/special_pred.m to
mdbcomp/prim_data.m so it can be used in dice.m and convert it
to a function.
library/list.m
Add map4, map5 and map6 since map6 is needed in dice.m.
And here's the interdiff:
diff -u browser/dice.m browser/dice.m
--- browser/dice.m 6 Feb 2005 07:47:34 -0000
+++ browser/dice.m 7 Feb 2005 03:53:38 -0000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1999-2005 The University of Melbourne.
+% Copyright (C) 2005 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.
%-----------------------------------------------------------------------------%
@@ -183,8 +183,8 @@
% read_dice_to_string(PassFiles, FailFile, SortStr, N, DiceStr,
% Problem, !IO).
% Read the trace_counts in the list of files in the file named
- % PassFiles, interpretting them as passing slices; read the
- % trace_counts from the file FailFile, interpretting it as a failing
+ % PassFiles, interpreting them as passing slices; read the
+ % trace_counts from the file FailFile, interpreting it as a failing
% slice; then produce a dice and convert the dice to a string suitable
% for displaying on the screen, sorting it first using SortStr.
% SortStr can be any combination of the letters "sSpPfP" and
@@ -365,7 +365,7 @@
:- func format_label_counts(list(label_count), int, int) = string.
format_label_counts(LabelCounts, TotalPassTests, _TotalFailTests) = Str :-
- dice.map6(deconstruct_label_count, LabelCounts, ProcLabels,
+ list.map6(deconstruct_label_count, LabelCounts, ProcLabels,
PathPorts, PassCounts, PassTests, FailCounts, _FailTests),
FormattedProcLabels = list.map(format_proc_label, ProcLabels),
FormattedPathPorts = list.map(format_path_port, PathPorts),
@@ -394,7 +394,7 @@
:- func suspicion_ratio(int, int) = float.
- % suspicion_ration gives an indication of how lightly a label is to
+ % suspicion_ratio gives an indication of how likely a label is to
% be buggy based on how many times it was executed in passing and
% failing test runs.
%
@@ -405,8 +405,7 @@
:- func format_float(int, float) = string.
-format_float(DecimalPlaces, Flt) = string.format("%." ++
- int_to_string(DecimalPlaces) ++ "f", [f(Flt)]).
+format_float(DecimalPlaces, Flt) = string.format("%.*f", [i(DecimalPlaces), f(Flt)]).
:- pred deconstruct_label_count(label_count::in, proc_label::out,
path_port::out, int::out, int::out, int::out, int::out) is det.
@@ -455,20 +454,8 @@
ProcLabel = special_proc(_, SpecialPredId, SymModule, TypeName,
Arity, _),
Module = sym_name_to_string(SymModule),
- (
- SpecialPredId = unify,
- Name = "__Unify__"
- ;
- SpecialPredId = index,
- Name = "__Index__"
- ;
- SpecialPredId = compare,
- Name = "__Compare__"
- ;
- SpecialPredId = initialise,
- Name = "__Initialise__"
- ),
- Str = Name ++ " for " ++ Module ++ "." ++ TypeName ++ "/" ++
+ Descr = special_pred_description(SpecialPredId),
+ Str = Descr ++ " for " ++ Module ++ "." ++ TypeName ++ "/" ++
int_to_string(Arity)
).
@@ -616,11 +603,0 @@
-
-:- pred map6(pred(T, T1, T2, T3, T4, T5, T6), list(T), list(T1),
- list(T2), list(T3), list(T4), list(T5), list(T6)).
-:- mode map6(pred(in, out, out, out, out, out, out) is det, in, out, out,
- out, out, out, out) is det.
-
-map6(_, [], [], [], [], [], [], []).
-map6(P, [H | T], [H1 | T1], [H2 | T2], [H3 | T3], [H4 | T4], [H5 | T5],
- [H6 | T6]) :-
- P(H, H1, H2, H3, H4, H5, H6),
- dice.map6(P, T, T1, T2, T3, T4, T5, T6).
diff -u doc/user_guide.texi doc/user_guide.texi
--- doc/user_guide.texi 6 Feb 2005 07:52:24 -0000
+++ doc/user_guide.texi 7 Feb 2005 03:28:44 -0000
@@ -3399,7 +3399,12 @@
failing test run. Before using the @samp{dice} command one or more passing
execution summaries and one failing execution summary should be generated.
This can be done by compiling the program with deep tracing enabled (either by
-compiling in the .debug or .decldebug grades or with the @samp{--trace deep}
+compiling in the .debug
+ at c XXX The following line removed until the .decldebug grade has been
+ at c documented.
+ at c or .decldebug
+grade
+or with the @samp{--trace deep}
compiler option) and then running the program with the MERCURY_OPTIONS
environment variable set to @samp{--trace-count}.
This will generate a file called
@@ -3409,10 +3414,10 @@
@samp{pass3}, etc. and a
failing slice, say @samp{fail}.
@sp 1
-Once one or more passing slices and a failing slice has been generated the
+Once one or more passing slices and a failing slice have been generated the
@samp{dice} command can be used to display a table of statistics comparing the
passing test runs to the failing run. Each row in the table contains statistics
-about the execution of a seperate goal in the program. Six columns are
+about the execution of a separate goal in the program. Six columns are
displayed:
@sp 1
@itemize @bullet
@@ -3421,7 +3426,7 @@
@item @samp{Path/Port}:
The goal path and/or port of the goal. For atomic goals, statistics about the
CALL event and the corresponding EXIT, FAIL or EXCP event are displayed on
-seperate rows. For other types of goals the goal path is displayed, except for
+separate rows. For other types of goals the goal path is displayed, except for
NEGE, NEGS and NEGF events where the goal path and port is displayed.
@item @samp{File:Line}:
The file name and line number of the goal. This can be used to set a
@@ -3442,12 +3447,12 @@
@end itemize
@sp 1
The name of the file containing the failing slice can be specified with the
- at samp{-f} or @samp{--fail-trace-count} option or with a seperate
+ at samp{-f} or @samp{--fail-trace-count} option or with a separate
@samp{set fail_trace_count @var{filename}} command.
@sp 1
The name of a file containing a list of the files containing the passing
slices can be given with the @samp{-p} or @samp{--pass-trace-counts} option.
-Alternatively a seperate @samp{set pass_trace_counts @var{filename}} command
+Alternatively a separate @samp{set pass_trace_counts @var{filename}} command
can be given.
@sp 1
The table can be sorted on the Pass, Fail or Suspicion columns, or a
only in patch2:
--- mdbcomp/prim_data.m 1 Feb 2005 07:11:42 -0000 1.2
+++ mdbcomp/prim_data.m 7 Feb 2005 02:31:52 -0000
@@ -102,6 +102,8 @@
; compare
; initialise.
+:- func special_pred_description(special_pred_id) = string.
+
% was in compiler/prog_util.m
% string_to_sym_name(String, Separator, SymName):
@@ -179,3 +181,8 @@
QualName) :-
sym_name_to_string(ModuleSym, Separator, ModuleName),
string__append_list([ModuleName, Separator, Name], QualName).
+
+special_pred_description(unify) = "unification predicate".
+special_pred_description(compare) = "comparison predicate".
+special_pred_description(index) = "indexing predicate".
+special_pred_description(initialise) = "initialisation predicate".
only in patch2:
--- library/list.m 2 Feb 2005 04:28:47 -0000 1.130
+++ library/list.m 7 Feb 2005 03:47:54 -0000
@@ -448,6 +448,60 @@
is nondet.
:- mode list__map3(pred(in, in, in, in) is semidet, in, in, in, in) is semidet.
+ % list__map4(T, L, M1, M2, M3, M4) uses the closure T
+ % to transform the elements of L into the elements of M1, M2, M3 and
+ % M4.
+:- pred list__map4(pred(A, B, C, D, E), list(A), list(B), list(C), list(D),
+ list(E)).
+:- mode list__map4(pred(in, out, out, out, out) is det, in, out, out, out, out)
+ is det.
+:- mode list__map4(pred(in, out, out, out, out) is cc_multi, in, out, out, out,
+ out) is cc_multi.
+:- mode list__map4(pred(in, out, out, out, out) is semidet, in, out, out, out,
+ out) is semidet.
+:- mode list__map4(pred(in, out, out, out, out) is multi, in, out, out, out,
+ out) is multi.
+:- mode list__map4(pred(in, out, out, out, out) is nondet, in, out, out, out,
+ out) is nondet.
+:- mode list__map4(pred(in, in, in, in, in) is semidet, in, in, in, in, in)
+ is semidet.
+
+ % list__map5(T, L, M1, M2, M3, M4, M5) uses the closure T
+ % to transform the elements of L into the elements of M1, M2, M3, M4
+ % and M5.
+:- pred list__map5(pred(A, B, C, D, E, F), list(A), list(B), list(C), list(D),
+ list(E), list(F)).
+:- mode list__map5(pred(in, out, out, out, out, out) is det, in, out, out, out,
+ out, out) is det.
+:- mode list__map5(pred(in, out, out, out, out, out) is cc_multi, in, out, out,
+ out, out, out) is cc_multi.
+:- mode list__map5(pred(in, out, out, out, out, out) is semidet, in, out, out,
+ out, out, out) is semidet.
+:- mode list__map5(pred(in, out, out, out, out, out) is multi, in, out, out,
+ out, out, out) is multi.
+:- mode list__map5(pred(in, out, out, out, out, out) is nondet, in, out, out,
+ out, out, out) is nondet.
+:- mode list__map5(pred(in, in, in, in, in, in) is semidet, in, in, in, in, in,
+ in) is semidet.
+
+ % list__map6(T, L, M1, M2, M3, M4, M5, M6) uses the closure T
+ % to transform the elements of L into the elements of M1, M2, M3, M4,
+ % M5 and M6.
+:- pred list__map6(pred(A, B, C, D, E, F, G), list(A), list(B), list(C),
+ list(D), list(E), list(F), list(G)).
+:- mode list__map6(pred(in, out, out, out, out, out, out) is det, in, out, out,
+ out, out, out, out) is det.
+:- mode list__map6(pred(in, out, out, out, out, out, out) is cc_multi, in, out,
+ out, out, out, out, out) is cc_multi.
+:- mode list__map6(pred(in, out, out, out, out, out, out) is semidet, in, out,
+ out, out, out, out, out) is semidet.
+:- mode list__map6(pred(in, out, out, out, out, out, out) is multi, in, out,
+ out, out, out, out, out) is multi.
+:- mode list__map6(pred(in, out, out, out, out, out, out) is nondet, in, out,
+ out, out, out, out, out) is nondet.
+:- mode list__map6(pred(in, in, in, in, in, in, in) is semidet, in, in, in, in,
+ in, in, in) is semidet.
+
% list__map_corresponding(F, [A1, .. An], [B1, .. Bn]) =
% [F(A1, B1), .., F(An, Bn)].
%
@@ -1418,6 +1472,23 @@
list__map3(P, [H0 | T0], [H1 | T1], [H2 | T2], [H3 | T3]) :-
call(P, H0, H1, H2, H3),
list__map3(P, T0, T1, T2, T3).
+
+list__map4(_, [], [], [], [], []).
+list__map4(P, [H0 | T0], [H1 | T1], [H2 | T2], [H3 | T3], [H4 | T4]) :-
+ call(P, H0, H1, H2, H3, H4),
+ list__map4(P, T0, T1, T2, T3, T4).
+
+list__map5(_, [], [], [], [], [], []).
+list__map5(P, [H0 | T0], [H1 | T1], [H2 | T2], [H3 | T3], [H4 | T4], [H5 | T5])
+ :-
+ call(P, H0, H1, H2, H3, H4, H5),
+ list__map5(P, T0, T1, T2, T3, T4, T5).
+
+list__map6(_, [], [], [], [], [], [], []).
+list__map6(P, [H0 | T0], [H1 | T1], [H2 | T2], [H3 | T3], [H4 | T4], [H5 | T5],
+ [H6 | T6]) :-
+ call(P, H0, H1, H2, H3, H4, H5, H6),
+ list__map6(P, T0, T1, T2, T3, T4, T5, T6).
list__map_corresponding(_, [], []) = [].
list__map_corresponding(_, [], [_ | _]) =
only in patch2:
--- compiler/special_pred.m 19 Jan 2005 03:10:55 -0000 1.47
+++ compiler/special_pred.m 7 Feb 2005 02:27:37 -0000
@@ -68,8 +68,6 @@
:- pred special_pred_get_type_det(special_pred_id::in, list(prog_var)::in,
prog_var::out) is det.
-:- pred special_pred_description(special_pred_id::in, string::out) is det.
-
%
% Succeeds if the declarations and clauses for the special predicates
% for the given type generated only when required.
@@ -177,11 +175,6 @@
;
error("special_pred_get_type_det: special_pred_get_type failed")
).
-
-special_pred_description(unify, "unification predicate").
-special_pred_description(compare, "comparison predicate").
-special_pred_description(index, "indexing predicate").
-special_pred_description(initialise, "initialisation predicate").
special_pred_is_generated_lazily(ModuleInfo, TypeCtor) :-
TypeCategory = classify_type_ctor(ModuleInfo, TypeCtor),
only in patch2:
--- compiler/hlds_out.m 2 Feb 2005 02:58:41 -0000 1.347
+++ compiler/hlds_out.m 7 Feb 2005 02:29:30 -0000
@@ -359,7 +359,7 @@
(
Origin = special_pred(SpecialId - TypeCtor)
->
- special_pred_description(SpecialId, Descr),
+ Descr = special_pred_description(SpecialId),
io__write_string(Descr, !IO),
TypeCtor = _TypeSymName - TypeArity,
( TypeArity = 0 ->
only in patch2:
--- compiler/hlds_error_util.m 1 Feb 2005 07:11:29 -0000 1.8
+++ compiler/hlds_error_util.m 7 Feb 2005 02:28:56 -0000
@@ -82,7 +82,7 @@
pred_info_get_markers(PredInfo, Markers),
pred_info_get_origin(PredInfo, Origin),
( Origin = special_pred(SpecialId - TypeCtor) ->
- special_pred_description(SpecialId, Descr),
+ Descr = special_pred_description(SpecialId),
TypeCtor = TypeSymName - TypeArity,
( TypeArity = 0 ->
Pieces = [words(Descr), words("for type"),
Ian.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list