[m-dev.] for review: clean up declarative debugger

[Mark Anthony BROWN]

Lee Naish writes:
> Mark Anthony BROWN <dougl at cs.mu.OZ.AU> writes:
> 
> >+		** MR_edt_{min,max}_depth.  These events are either
> >+		** irrelevant, or else implicitly represented in the
> >+		** structure being built.
> 
> Additional comments somewhere would be nice (eg this implicit
> representation).  Maybe they existed already and are not in the diff?

Some comments existed already.  I have improved them, and added a
reference to them from here.

> 
> As above.  More comments would be nice...

Ok.

> 
> A possible answer to the objection above is that edt_first_child etc are
> just the implementation of a well defined ADT.  That would be a good
> answer if the ADT was properly documented and the interface and
> implementation were properly separated.  However, edt_children and
> edt_root (a nice abstract interface) are defined at the same level as
> edt_first_child and there are not even any comments on these procedures.

The ADT is now clearly defined by a typeclass.

> 
> > :- pred query_oracle(edt_node, bool, io__state, io__state).
> > :- mode query_oracle(in, out, di, uo) is det.
> 
> Its worth saying that eventually an oracle database will be passed
> around.  In fact I think its worth defining the right interfaces which
> allow for this even if its not currently used (you can pass around a
> dummy database which is never actually used - then future version will
> be just changing the implementation of predicates with well defined
> interfaces.  You will probably have to add an extra couple of arguments
> to a bunch of preds, but the basic structure should remain the same (the
> use of io__state has forced you to use the "right" structure anyway).
> 

Ok, I now thread a dummy around, but I don't (yet) save it from one call
to the next.

> I think the use of type bool here will have to be changed eventually
> also.  We may want to implement the three valued scheme and/or "don't
> know" answers (see below).  I think introducing a new type, eg
> edt_truth, is warranted.

Good idea.

> 
> > :- type debugger_command
> >	--->	yes
> >	;	no
> >	;	browse
> >	;	tree
> >	;	help
> >	;	unknown.
> 
> I suggest unknown be replaced by invalid/unrecognised/...
> Eventually it would be nice for users to be able to respond "don't know"
> to questions and then "unknown" will get confusing.

Good point.

The following diff addresses the above concerns.

Cheers,
Mark.

Estimated hours taken: 12

Clean up the declarative debugger.

browser/declarative_debugger.m:
browser/declarative_oracle.m:
	- Add a new type, oracle_data, to store the oracle database.
	- Thread an oracle database through a single call to the
	  front end.
	- Replace `unknown' with a less overloaded name in
	  some type definitions.

trace/mercury_trace_declarative.c:
trace/mercury_trace_declarative.h:
browser/declarative_debugger.m:
	- Improve documentation.

browser/declarative_debugger.m:
	- Export new type, edt_truth.
	- Improve the interface to the oracle.
	- Add a new typeclass, evaluation_tree, and update the
	  previous interface to reflect this.
	- Make declarative_bug a polymorphic type, and change the
	  constructor for buggy nodes from `wrong' to `e_bug'.

Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.3
diff -u -r1.3 declarative_debugger.m
--- declarative_debugger.m	1999/04/16 03:07:39	1.3
+++ declarative_debugger.m	1999/04/25 17:04:00
@@ -5,23 +5,42 @@
 %-----------------------------------------------------------------------------%
 % File: declarative_debugger.m
 % Author: Mark Brown
-% Purpose:
-%	This module is the front end of a Mercury declarative debugger.
-% It is called by the back end, in trace/mercury_trace_declarative.c, and
-% is passed an evaluation dependency tree (EDT).  It then analyses this to
-% diagnose a bug.
 %
-% The implementation is in two sections:
-%	- Mercury interface to the main data structure.
-%	- Implementation of the analysis algorithm.
+% This module has two main purposes:
+% 	- to define the interface between the front and back ends of
+% 	  a Mercury declarative debugger, and
+% 	- to implement a front end.
+%
+% The interface between the front and back ends is partly defined
+% by the evaluation_tree typeclass.  An instance of this typeclass
+% implements evaluation dependency trees (EDTs), which are created
+% in the back end and passed to the front end for analysis.  The rest
+% of the interface is via analyse_edt/7, which is how the front end
+% is called from the back end.
+%
+% The front end implemented in this module analyses the EDT it is
+% passed to diagnose a bug.  It does this by a simple top-down search.
 %
 
 :- module declarative_debugger.
 :- interface.
-:- import_module io, list, string, std_util.
+:- import_module io, list, string, std_util, bool.
+:- import_module declarative_oracle.
 
-:- type evaluation_tree.
+	%
+	% This type represents the possible truth values for nodes
+	% in the EDT.
+	%
+:- type edt_truth == bool.
 
+	%
+	% Values of this type represent EDT nodes.  This representation
+	% is used by the front end (in this module), as well as the
+	% oracle (in browser/declarative_oracle.m).
+	%
+	% There will be nodes other than wrong_answer in future, such
+	% as for missing answer analysis.
+	%
 :- type edt_node
 			%
 			% The node is a possible wrong answer.  The first
@@ -30,57 +49,67 @@
 			%
 	--->	wrong_answer(string, list(univ)).
 
-
 	%
-	% This procedure is exported to C to be called from the back
-	% end of the declarative debugger.
+	% Display the node in user readable form on the current
+	% output stream.
 	%
-:- pred analyse_edt(evaluation_tree, io__input_stream, io__output_stream,
-		io__state, io__state).
-:- mode analyse_edt(in, in, in, di, uo) is det.
-
+:- pred write_node(edt_node, io__state, io__state).
+:- mode write_node(in, di, uo) is det.
 
 	%
-	% This prints the atom to the current output stream.
+	% See comments above.
 	%
-:- pred write_atom(string, list(univ), io__state, io__state).
-:- mode write_atom(in, in, di, uo) is det.
+:- typeclass evaluation_tree(Tree) where [
+	pred edt_root(Tree, edt_node),
+	mode edt_root(in, out) is det,
+
+	pred edt_children(Tree, list(Tree)),
+	mode edt_children(in, out) is det
+].
+
+:- pred analyse_edt(T, io__input_stream, io__output_stream, oracle_data,
+		oracle_data, io__state, io__state) <= evaluation_tree(T).
+:- mode analyse_edt(in, in, in, in, out, di, uo) is det.
 
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module bool, require, int, char.
-:- import_module declarative_oracle.
+:- import_module require, int, char.
 
 	%
-	% This section contains the Mercury interface to the EDTs that
-	% are built by the back end.
+	% This section defines the Mercury instance of the evaluation
+	% tree.
 	%
 
-:- type evaluation_tree == c_pointer.
+:- instance evaluation_tree(mercury_edt) where [
+	pred(edt_root/2) is mercury_edt_root,
+	pred(edt_children/2) is mercury_edt_children
+].
+
+:- type mercury_edt == c_pointer.
 
-:- pred edt_children(evaluation_tree, list(evaluation_tree)).
-:- mode edt_children(in, out) is det.
+:- pred mercury_edt_children(mercury_edt, list(mercury_edt)).
+:- mode mercury_edt_children(in, out) is det.
 
-edt_children(EDT, Children) :-
+mercury_edt_children(EDT, Children) :-
 	(
-		edt_first_child(EDT, FirstChild)
+		mercury_edt_first_child(EDT, FirstChild)
 	->
-		edt_children_2(FirstChild, Children0),
+		mercury_edt_children_2(FirstChild, Children0),
 		Children = [FirstChild | Children0]
 	;
 		Children = []
 	).
 
 
-:- pred edt_children_2(evaluation_tree, list(evaluation_tree)).
-:- mode edt_children_2(in, out) is det.
+:- pred mercury_edt_children_2(mercury_edt, list(mercury_edt)).
+:- mode mercury_edt_children_2(in, out) is det.
 
-edt_children_2(Child, Siblings) :-
+mercury_edt_children_2(Child, Siblings) :-
 	(
-		edt_sibling(Child, Sibling)
+		mercury_edt_sibling(Child, Sibling)
 	->
-		edt_children_2(Sibling, Siblings0),
+		mercury_edt_children_2(Sibling, Siblings0),
 		Siblings = [Sibling | Siblings0]
 	;
 		Siblings = []
@@ -92,10 +121,10 @@
 	#include ""mercury_wrapper.h""
 ").
 
-:- pred edt_first_child(evaluation_tree, evaluation_tree).
-:- mode edt_first_child(in, out) is semidet.
+:- pred mercury_edt_first_child(mercury_edt, mercury_edt).
+:- mode mercury_edt_first_child(in, out) is semidet.
 
-:- pragma c_code(edt_first_child(Parent::in, Child::out),
+:- pragma c_code(mercury_edt_first_child(Parent::in, Child::out),
 	[will_not_call_mercury],
 	"
 		MR_Edt_Node	*parent;
@@ -112,10 +141,10 @@
 	"
 ).
 
-:- pred edt_sibling(evaluation_tree, evaluation_tree).
-:- mode edt_sibling(in, out) is semidet.
+:- pred mercury_edt_sibling(mercury_edt, mercury_edt).
+:- mode mercury_edt_sibling(in, out) is semidet.
 
-:- pragma c_code(edt_sibling(Child::in, Sibling::out),
+:- pragma c_code(mercury_edt_sibling(Child::in, Sibling::out),
 	[will_not_call_mercury],
 	"
 		MR_Edt_Node	*child;
@@ -132,10 +161,10 @@
 	"
 ).
 
-:- pred edt_root(evaluation_tree, edt_node).
-:- mode edt_root(in, out) is det.
+:- pred mercury_edt_root(mercury_edt, edt_node).
+:- mode mercury_edt_root(in, out) is det.
 
-:- pragma c_code(edt_root(EDT::in, Root::out),
+:- pragma c_code(mercury_edt_root(EDT::in, Root::out),
 	[will_not_call_mercury],
 	"
 		#ifdef MR_USE_DECLARATIVE_DEBUGGER
@@ -169,25 +198,49 @@
 	% This is what the analysis can currently find.
 	%
 
-:- type declarative_bug
-	--->	unknown
-	;	wrong(evaluation_tree).
+:- type declarative_bug(T)		% <= evaluation_tree(T)
+	--->	not_found
+			%
+			% An EDT whose root node is erroneous but
+			% all children are correct.
+			%
+	;	e_bug(T).
 
 
-:- pragma export(declarative_debugger__analyse_edt(in, in, in, di, uo),
+	%
+	% To simplify calling this module from C code, we export
+	% a version of analyse_edt which is specifically for the instance
+	% used by the current back end.
+	%
+:- pred analyse_mercury_edt(mercury_edt, io__input_stream, io__output_stream,
+		io__state, io__state).
+:- mode analyse_mercury_edt(in, in, in, di, uo) is det.
+
+:- pragma export(declarative_debugger__analyse_mercury_edt(in, in, in, di, uo),
 		"ML_DD_analyse_edt").
 
-analyse_edt(EDT, MdbIn, MdbOut) -->
+analyse_mercury_edt(EDT, MdbIn, MdbOut) -->
+		%
+		% XXX this data structure needs to be more
+		% persistent.  It really should be saved between
+		% calls to this predicate.
+		%
+	{ oracle_data_init(Oracle0) },
+	analyse_edt(EDT, MdbIn, MdbOut, Oracle0, _).
+
+
+analyse_edt(EDT, MdbIn, MdbOut, Oracle0, Oracle) -->
 	io__set_input_stream(MdbIn, OldIn),
 	io__set_output_stream(MdbOut, OldOut),
 	{ edt_root(EDT, RootNode) },
-	query_oracle(RootNode, Valid),
+	query_oracle(RootNode, Valid, Oracle0, Oracle1),
 	(
 		{ Valid = yes },
-		{ Bug = unknown }
+		{ Bug = not_found },
+		{ Oracle = Oracle1 }
 	;
 		{ Valid = no },
-		analyse_edt_2(EDT, Bug)
+		analyse_edt_2(EDT, Bug, Oracle1, Oracle)
 	),
 	report_bug(Bug),
 	io__set_input_stream(OldIn, _),
@@ -197,40 +250,43 @@
 	%
 	% Assumes the root note is not valid.
 	%
-:- pred analyse_edt_2(evaluation_tree, declarative_bug, io__state, io__state).
-:- mode analyse_edt_2(in, out, di, uo) is det.
+:- pred analyse_edt_2(T, declarative_bug(T), oracle_data, oracle_data,
+		io__state, io__state) <= evaluation_tree(T).
+:- mode analyse_edt_2(in, out, in, out, di, uo) is det.
 
-analyse_edt_2(EDT, Bug) -->
+analyse_edt_2(EDT, Bug, Oracle0, Oracle) -->
 	{ edt_children(EDT, Children) },
-	analyse_children(Children, wrong(EDT), Bug).
+	analyse_children(Children, e_bug(EDT), Bug, Oracle0, Oracle).
 
 
-:- pred analyse_children(list(evaluation_tree), declarative_bug,
-		declarative_bug, io__state, io__state).
-:- mode analyse_children(in, in, out, di, uo) is det.
+:- pred analyse_children(list(T), declarative_bug(T), declarative_bug(T),
+		oracle_data, oracle_data, io__state, io__state)
+				<= evaluation_tree(T).
+:- mode analyse_children(in, in, out, in, out, di, uo) is det.
 
-analyse_children([], Bug, Bug) -->
+analyse_children([], Bug, Bug, Oracle, Oracle) -->
 	[].
-analyse_children([Child | Children], Bug0, Bug) -->
+analyse_children([Child | Children], Bug0, Bug, Oracle0, Oracle) -->
 	{ edt_root(Child, ChildNode) },
-	query_oracle(ChildNode, Valid),
+	query_oracle(ChildNode, Valid, Oracle0, Oracle1),
 	(
 		{ Valid = yes },
-		analyse_children(Children, Bug0, Bug)
+		analyse_children(Children, Bug0, Bug, Oracle1, Oracle)
 	;
 		{ Valid = no },
-		analyse_edt_2(Child, Bug)
+		analyse_edt_2(Child, Bug, Oracle1, Oracle)
 	).
 
 
-:- pred report_bug(declarative_bug, io__state, io__state).
+:- pred report_bug(declarative_bug(T), io__state, io__state)
+		<= evaluation_tree(T).
 :- mode report_bug(in, di, uo) is det.
 
-report_bug(unknown) -->
+report_bug(not_found) -->
 	io__write_string("Bug not found.\n").
-report_bug(wrong(EDT)) -->
+report_bug(e_bug(EDT)) -->
 	io__write_string("Incorrect instance found:\n\n"),
-	write_root_atom(EDT),
+	write_root_node(EDT),
 	{ edt_children(EDT, Children0) },
 	(
 		{ Children0 = [Child | Children1] }
@@ -239,39 +295,35 @@
 		{ list__reverse(Children1, Children) },
 		write_children(Children),
 		io__write_char('\t'),
-		write_root_atom(Child)
+		write_root_node(Child)
 	;
 		[]
 	),
 	io__write_string(".\n\n").
 
 
-:- pred write_children(list(evaluation_tree), io__state, io__state).
+:- pred write_children(list(T), io__state, io__state) <= evaluation_tree(T).
 :- mode write_children(in, di, uo) is det.
 
 write_children([]) -->
 	[].
 write_children([Child | Children]) -->
 	io__write_char('\t'),
-	write_root_atom(Child),
+	write_root_node(Child),
 	io__write_string(",\n"),
 	write_children(Children).
 
 
-:- pred write_root_atom(evaluation_tree, io__state, io__state).
-:- mode write_root_atom(in, di, uo) is det.
+:- pred write_root_node(T, io__state, io__state) <= evaluation_tree(T).
+:- mode write_root_node(in, di, uo) is det.
 
-write_root_atom(EDT) -->
+write_root_node(EDT) -->
 	{ edt_root(EDT, RootNode) },
-	{
-		RootNode = wrong_answer(Name0, Args0),
-		Name = Name0,
-		Args = Args0
-	},
-	write_atom(Name, Args).
+	write_node(RootNode).
 
 
-write_atom(Name, Args) -->
+write_node(Node) -->
+	{ Node = wrong_answer(Name, Args) },
 	io__write_string(Name),
 	(
 		{ Args = [Arg1 | Args0] }
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.1
diff -u -r1.1 declarative_oracle.m
--- declarative_oracle.m	1999/04/12 04:11:42	1.1
+++ declarative_oracle.m	1999/04/25 17:04:00
@@ -18,17 +18,32 @@
 :- import_module declarative_debugger.
 
 	%
+	% The oracle database.  This is threaded around the declarative
+	% debugger, but currently stores no information.
+	%
+:- type oracle_data.
+
+	%
 	% Query the oracle about the program being debugged.  The first
 	% argument is a node in the evaluation tree, the second argument
-	% is its validity in the intended interpreation.
+	% is its validity in the intended interpretation.
+	%
+:- pred query_oracle(edt_node, edt_truth, oracle_data, oracle_data,
+		io__state, io__state).
+:- mode query_oracle(in, out, in, out, di, uo) is det.
+
+	%
+	% Produce a new oracle state.
 	%
-:- pred query_oracle(edt_node, bool, io__state, io__state).
-:- mode query_oracle(in, out, di, uo) is det.
+:- pred oracle_data_init(oracle_data).
+:- mode oracle_data_init(out) is det.
 
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module list, char, require.
+:- import_module list, char, require, std_util.
+
+:- type oracle_data == unit.
 
 :- type debugger_command
 	--->	yes
@@ -36,27 +51,32 @@
 	;	browse
 	;	tree
 	;	help
-	;	unknown.
+	;	illegal_command.
 
 
-query_oracle(Node, Valid) -->
-	write_node(Node),
+oracle_data_init(unit).
+
+
+query_oracle(Node, Valid, Oracle0, Oracle) -->
+	query_user(Node),
 	io__flush_output,
 	get_command(Answer),
 	(
 		{ Answer = yes },
-		{ Valid = yes }
+		{ Valid = yes },
+		{ Oracle = Oracle0 }
 	;
 		{ Answer = no },
-		{ Valid = no }
+		{ Valid = no },
+		{ Oracle = Oracle0 }
 	;
 		{ Answer = browse },
 		io__write_string("Sorry, not implemented.\n"),
-		query_oracle(Node, Valid)
+		query_oracle(Node, Valid, Oracle0, Oracle)
 	;
 		{ Answer = tree },
 		io__write_string("Sorry, not implemented.\n"),
-		query_oracle(Node, Valid)
+		query_oracle(Node, Valid, Oracle0, Oracle)
 	;
 		{ Answer = help },
 		io__write_strings([
@@ -68,19 +88,19 @@
 %			"\tt\tprint the evaluation tree (not yet)\n",
 			"\th, ?\tthis help message\n"
 		]),
-		query_oracle(Node, Valid)
+		query_oracle(Node, Valid, Oracle0, Oracle)
 	;
-		{ Answer = unknown },
+		{ Answer = illegal_command },
 		io__write_string("Unknown command, 'h' for help.\n"),
-		query_oracle(Node, Valid)
+		query_oracle(Node, Valid, Oracle0, Oracle)
 	).
 
 
-:- pred write_node(edt_node, io__state, io__state).
-:- mode write_node(in, di, uo) is det.
+:- pred query_user(edt_node, io__state, io__state).
+:- mode query_user(in, di, uo) is det.
 
-write_node(wrong_answer(Name, Args)) -->
-	write_atom(Name, Args),
+query_user(Node) -->
+	write_node(Node),
 	io__nl,
 	io__write_string("Valid? ").
 
@@ -98,11 +118,11 @@
 		->
 			Command = Command0
 		;
-			Command = unknown
+			Command = illegal_command
 		)
 	;
 		% XXX this should definitely be handled better.
-		error("I/O error or EOF.\n")
+		Command = illegal_command
 	}.
 
 
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace_declarative.c
--- mercury_trace_declarative.c	1999/04/20 12:38:40	1.6
+++ mercury_trace_declarative.c	1999/04/25 17:04:40
@@ -13,6 +13,18 @@
 ** Tree (EDT).  Once built, the EDT is passed to the front end where it can
 ** be analysed to find bugs.  The front end is implemented in
 ** browse/declarative_debugger.m.
+**
+** The interface between the front and back ends is via the
+** evaluation_tree typeclass, which is documented in
+** browse/declarative_debugger.m.  It would be possible to replace
+** the front end or the back end with an alternative implementation
+** which also conforms to the typeclass constraints.  For example:
+** 	- An alternative back end could generate the same EDT
+** 	  structure in a different way, such as via program
+** 	  transformation.
+** 	- An alternative front end could graphically display the
+** 	  generated EDTs as part of a visualization tool rather
+** 	  than analyzing them for bugs.
 */
 
 #include "mercury_imp.h"
@@ -132,7 +144,8 @@
 		** out events with a depth outside the range given by
 		** MR_edt_{min,max}_depth.  These events are either
 		** irrelevant, or else implicitly represented in the
-		** structure being built.
+		** structure being built.  See comment in
+		** trace/mercury_trace_declarative.h.
 		*/
 		return NULL;
 	}
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_trace_declarative.h
--- mercury_trace_declarative.h	1999/04/12 04:11:47	1.3
+++ mercury_trace_declarative.h	1999/04/25 17:04:42
@@ -10,8 +10,9 @@
 /*
 ** This file defines the MR_Edt_Node data type, which stores nodes
 ** of an Evaluation Dependency Tree (EDT), used for declarative
-** debugging.  It also defines an interface to the back end of the
-** declarative debugger from the internal debugger.
+** debugging.  This is the underlying implementation of mercury_edt,
+** which is an instance of the evaluation_tree typeclass.  These
+** are defined in browser/declarative_debugger.m.
 */
 
 #include "mercury_imp.h"
@@ -24,8 +25,16 @@
 ** represented nodes.
 **
 ** Implicit nodes are similar to explicit nodes, but they do not
-** store their children.  The children can be created by re-executing
-** the events in the stored range and collecting a new EDT.
+** store their children.  They do, however, store enough information
+** to allow execution to be resumed at that point, so children can
+** be created by re-executing the events in the stored range and
+** collecting a new EDT.  XXX this is not yet implemented, though.
+**
+** In the future there will also be nodes to handle:
+** 	- missing answer analysis
+** 	- calls to solutions/2 and related predicates
+** 	- exceptions
+** and possibly other things as well.
 */
 
 typedef enum {

-- 
Mark Brown  (dougl at cs.mu.oz.au)       )O+   |  For Microsoft to win,
MEngSc student,                             |  the customer must lose
Dept of Computer Science, Melbourne Uni     |          -- Eric S. Raymond
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------