[m-rev.] for review: add `mode' command to interactive term browser
Ian MacLarty
maclarty at cs.mu.OZ.AU
Thu Jan 6 12:04:57 AEDT 2005
This is like the 3rd time I'm trying to send this email - doesn't seem
to want to come through for some reason...
For review by anyone.
Estimated hours taken: 5
Branches: main
Add `mode' command to interactive term browser to display the mode of a
sub-term. At the moment this command only works when the term browser is
invoked from inside the declarative debugger.
browser/browser_info.m
Allow a function to be passed to the browser which it can call to
work out the mode of a sub-term.
browser/browse.m
Export versions of the browser invocation predicates that don't
accept a mode function.
Handle the `mode' browser command by calling the supplied function
if it's present.
Document the `mode' command in the browser help message.
browser/declarative_debugger.m
To determine the mode of a sub-term we compare the state of
instantiation of the sub-term at the CALL event and at the EXIT, FAIL
or EXCP event. To do this we need the initial and final
atoms for incorrect contour bugs and wrong answer nodes (for
other nodes the initial and final atoms are the same).
browser/declarative_oracle.m
The wrong_answer functor now has 3 arguments.
browser/declarative_tree.m
Export trace_atom_subterm_is_ground/3 for use in declarative_user.m.
Include the initial atom in wrong answer nodes and incorrect contour
bugs.
browser/declarative_user.m
Add function arg_num_to_arg_pos to replace some duplicated code.
Alter the edt_node_trace_atom predicate to find the initial and the
final atoms for a question.
Add a function to find the mode of a sub-term given the path to the
sub-term and the initial and final atoms. Pass this function to
the browser so it can work out the mode of a sub-term.
browser/parse.m
Parse `mode' command.
tests/debugger/declarative/Mmakefile
tests/debugger/declarative/browser_mode.exp
tests/debugger/declarative/browser_mode.inp
tests/debugger/declarative/browser_mode.m
Test the `mode' command.
Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.48
diff -u -r1.48 browse.m
--- browser/browse.m 11 Dec 2004 01:59:50 -0000 1.48
+++ browser/browse.m 5 Jan 2005 05:03:42 -0000
@@ -25,10 +25,30 @@
:- import_module io, std_util, list.
% The interactive term browser. The caller type will be `browse', and
+ % the default format for the `browse' caller type will be used. Since
+ % this predicate is exported to be used by C code, no mode function
+ % can be supplied.
+ %
+:- pred browse__browse_browser_term_no_modes(browser_term::in,
+ io__input_stream::in, io__output_stream::in, maybe(list(dir))::out,
+ browser_persistent_state::in, browser_persistent_state::out,
+ io::di, io::uo) is cc_multi.
+
+ % The interactive term browser. The caller type will be `browse' and
% the default format for the `browse' caller type will be used.
%
:- pred browse__browse_browser_term(browser_term::in,
- io__input_stream::in, io__output_stream::in, maybe(list(dir))::out,
+ io__input_stream::in, io__output_stream::in,
+ maybe(browser_mode_func)::in, maybe(list(dir))::out,
+ browser_persistent_state::in, browser_persistent_state::out,
+ io::di, io::uo) is cc_multi.
+
+ % As above, except that the supplied format will override the default.
+ % Again, this is exported to C code, so the mode function can't be
+ % supplied.
+ %
+:- pred browse__browse_browser_term_format_no_modes(browser_term::in,
+ io__input_stream::in, io__output_stream::in, portray_format::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
@@ -36,17 +56,28 @@
%
:- pred browse__browse_browser_term_format(browser_term::in,
io__input_stream::in, io__output_stream::in, portray_format::in,
+ maybe(browser_mode_func)::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% The browser interface for the external debugger. The caller type
% will be `browse', and the default format will be used.
+ % This version is exported for use in C code, so no mode functin
+ % can be supplied.
%
-:- pred browse__browse_external(T::in, io__input_stream::in,
+:- pred browse__browse_external_no_modes(T::in, io__input_stream::in,
io__output_stream::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
+ % The browser interface for the external debugger. The caller type
+ % will be `browse', and the default format will be used.
+ %
+:- pred browse__browse_external(T::in, io__input_stream::in,
+ io__output_stream::in, maybe(browser_mode_func)::in,
+ browser_persistent_state::in, browser_persistent_state::out,
+ io::di, io::uo) is cc_multi.
+
% The non-interactive term browser. The caller type should be either
% `print' or `print_all'. The default portray format for that
% caller type is used.
@@ -119,11 +150,11 @@
% they are used in trace/mercury_trace_browser.c.
%
-:- pragma export(browse__browse_browser_term(in, in, in, out, in, out, di, uo),
- "ML_BROWSE_browse_browser_term").
-:- pragma export(browse__browse_browser_term_format(in, in, in, in, in, out,
- di, uo), "ML_BROWSE_browse_browser_term_format").
-:- pragma export(browse__browse_external(in, in, in, in, out, di, uo),
+:- pragma export(browse__browse_browser_term_no_modes(in, in, in, out, in, out,
+ di, uo), "ML_BROWSE_browse_browser_term").
+:- pragma export(browse__browse_browser_term_format_no_modes(in, in, in, in,
+ in, out, di, uo), "ML_BROWSE_browse_browser_term_format").
+:- pragma export(browse__browse_external_no_modes(in, in, in, in, out, di, uo),
"ML_BROWSE_browse_external").
:- pragma export(browse__print_browser_term(in, in, in, in, di, uo),
"ML_BROWSE_print_browser_term").
@@ -330,7 +361,7 @@
browse__print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State,
!IO):-
- Info = browser_info__init(BrowserTerm, Caller, MaybeFormat, State),
+ Info = browser_info__init(BrowserTerm, Caller, MaybeFormat, no, State),
io__set_output_stream(OutputStream, OldStream, !IO),
browser_info__get_format(Info, Caller, MaybeFormat, Format),
%
@@ -354,28 +385,46 @@
% Interactive display
%
-browse__browse_browser_term(Term, InputStream, OutputStream, MaybeMark,
- !State, !IO) :-
- browse_common(internal, Term, InputStream, OutputStream, no,
+browse__browse_browser_term_no_modes(Term, InputStream, OutputStream,
+ MaybeMark, !State, !IO) :-
+ browse_common(internal, Term, InputStream, OutputStream, no, no,
MaybeMark, !State, !IO).
-browse__browse_browser_term_format(Term, InputStream, OutputStream, Format,
- !State, !IO) :-
+browse__browse_browser_term(Term, InputStream, OutputStream, MaybeModeFunc,
+ MaybeMark, !State, !IO) :-
+ browse_common(internal, Term, InputStream, OutputStream, no,
+ MaybeModeFunc, MaybeMark, !State, !IO).
+
+browse__browse_browser_term_format_no_modes(Term, InputStream, OutputStream,
+ Format, !State, !IO) :-
+ browse_common(internal, Term, InputStream, OutputStream, yes(Format),
+ no, _, !State, !IO).
+
+browse__browse_browser_term_format(Term, InputStream, OutputStream,
+ Format, MaybeModeFunc, !State, !IO) :-
browse_common(internal, Term, InputStream, OutputStream, yes(Format),
- _, !State, !IO).
+ MaybeModeFunc, _, !State, !IO).
-browse__browse_external(Term, InputStream, OutputStream, !State, !IO) :-
+browse__browse_external_no_modes(Term, InputStream, OutputStream, !State, !IO)
+ :-
browse_common(external, plain_term(univ(Term)),
- InputStream, OutputStream, no, _, !State, !IO).
+ InputStream, OutputStream, no, no, _, !State, !IO).
+
+browse__browse_external(Term, InputStream, OutputStream, MaybeModeFunc, !State,
+ !IO) :-
+ browse_common(external, plain_term(univ(Term)),
+ InputStream, OutputStream, no, MaybeModeFunc, _, !State, !IO).
:- pred browse_common(debugger::in, browser_term::in, io__input_stream::in,
- io__output_stream::in, maybe(portray_format)::in,
- maybe(list(dir))::out, browser_persistent_state::in,
- browser_persistent_state::out, io::di, io::uo) is cc_multi.
+ io__output_stream::in, maybe(portray_format)::in,
+ maybe(browser_mode_func)::in, maybe(list(dir))::out,
+ browser_persistent_state::in, browser_persistent_state::out,
+ io::di, io::uo) is cc_multi.
browse_common(Debugger, Object, InputStream, OutputStream, MaybeFormat,
- MaybeMark, !State, !IO) :-
- Info0 = browser_info__init(Object, browse, MaybeFormat, !.State),
+ MaybeModeFunc, MaybeMark, !State, !IO) :-
+ Info0 = browser_info__init(Object, browse, MaybeFormat, MaybeModeFunc,
+ !.State),
io__set_input_stream(InputStream, OldInputStream, !IO),
io__set_output_stream(OutputStream, OldOutputStream, !IO),
% startup_message,
@@ -502,6 +551,18 @@
Quit = no
)
;
+ Command = mode_query,
+ MaybeModeFunc = !.Info ^ maybe_mode_func,
+ write_term_mode_debugger(Debugger, MaybeModeFunc,
+ !.Info ^ dirs, !IO),
+ Quit = no
+ ;
+ Command = mode_query(Path),
+ change_dir(!.Info ^ dirs, Path, NewPwd),
+ MaybeModeFunc = !.Info ^ maybe_mode_func,
+ write_term_mode_debugger(Debugger, MaybeModeFunc, NewPwd, !IO),
+ Quit = no
+ ;
Command = quit,
Quit = yes
;
@@ -608,6 +669,7 @@
"\t -- set a parameter value\n",
"\tset -- show parameter values\n",
"\tmark [path] -- mark the given subterm (default is current) and quit\n",
+"\tmode [path] -- show the mode of a subterm (default is current)\n",
"\tquit -- quit browser\n",
"\thelp -- show this help message\n",
"SICStus Prolog style commands are:\n",
@@ -1571,6 +1633,28 @@
io__write_string(String, !IO).
write_string_debugger(external, String, !IO) :-
send_term_to_socket(browser_str(String), !IO).
+
+:- pred write_term_mode_debugger(debugger::in, maybe(browser_mode_func)::in,
+ list(dir)::in, io::di, io::uo) is det.
+
+write_term_mode_debugger(Debugger, MaybeModeFunc, Dirs, !IO) :-
+ (
+ MaybeModeFunc = yes(ModeFunc),
+ Mode = ModeFunc(Dirs),
+ ModeStr = browser_mode_to_string(Mode),
+ write_string_debugger(Debugger, ModeStr ++ "\n", !IO)
+ ;
+ MaybeModeFunc = no,
+ write_string_debugger(Debugger,
+ "Mode information not available.\n", !IO)
+ ).
+
+:- func browser_mode_to_string(browser_term_mode) = string.
+
+browser_mode_to_string(input) = "Input".
+browser_mode_to_string(output) = "Output".
+browser_mode_to_string(not_applicable) = "Not Applicable".
+browser_mode_to_string(unbound) = "Unbound".
:- pred nl_debugger(debugger::in, io::di, io::uo) is det.
Index: browser/browser_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browser_info.m,v
retrieving revision 1.16
diff -u -r1.16 browser_info.m
--- browser/browser_info.m 27 Oct 2004 02:23:27 -0000 1.16
+++ browser/browser_info.m 5 Jan 2005 03:11:30 -0000
@@ -40,12 +40,40 @@
% mdb command.
state :: browser_persistent_state,
% Persistent settings.
- maybe_mark :: maybe(list(dir))
+ maybe_mark :: maybe(list(dir)),
% Location of the marked term
% relative to the root, or `no'
% if there is no mark.
+ maybe_mode_func :: maybe(browser_mode_func)
+ % An optional function to determine the
+ % mode of a particular sub-term should
+ % the user issue a `mode' query.
).
+ % A signature for functions that can be used by the browser to work
+ % out the mode of a sub-term.
+ %
+:- type browser_mode_func == (func(list(dir)) = browser_term_mode).
+
+ % The possible modes of a sub-term in the browser. Note these do
+ % not correspond directly with the declared Mercury modes.
+ %
+:- type browser_term_mode
+ % The sub-term is bound at the call. This could
+ % correspond to the Mercury modes `in', `di', `ui',
+ % etc.
+ ---> input
+ % The sub-term is unbound at the call. The call
+ % succeeded and bound the sub-term. This could
+ % correspond to the Mercury modes `out', `uo', etc.
+ ; output
+ % The sub-term is unbound at the call and at the
+ % final EXIT, FAIL or EXCP event.
+ ; unbound
+ % If the user asks about the mode of an atom, this
+ % value should be returned by the mode function.
+ ; not_applicable.
+
:- type dir
---> parent
; child_num(int)
@@ -95,7 +123,8 @@
% overrides the default format.
%
:- func browser_info__init(browser_term, browse_caller_type,
- maybe(portray_format), browser_persistent_state) = browser_info.
+ maybe(portray_format), maybe(browser_mode_func),
+ browser_persistent_state) = browser_info.
% Get the format to use for the given caller type. The optional
% portray_format overrides the current default.
@@ -261,8 +290,10 @@
%---------------------------------------------------------------------------%
-browser_info__init(BrowserTerm, CallerType, MaybeFormat, State) =
- browser_info(BrowserTerm, [], CallerType, MaybeFormat, State, no).
+browser_info__init(BrowserTerm, CallerType, MaybeFormat, MaybeModeFunc,
+ State) =
+ browser_info(BrowserTerm, [], CallerType, MaybeFormat, State, no,
+ MaybeModeFunc).
browser_info__get_format(Info, Caller, MaybeFormat, Format) :-
(
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.43
diff -u -r1.43 declarative_debugger.m
--- browser/declarative_debugger.m 16 Dec 2004 00:12:38 -0000 1.43
+++ browser/declarative_debugger.m 4 Jan 2005 05:17:09 -0000
@@ -97,6 +97,8 @@
:- type decl_e_bug
---> incorrect_contour(
+ init_decl_atom, % The head of the clause, in its
+ % inital state of instantiation.
final_decl_atom,% The head of the clause, in its
% final state of instantiation.
decl_contour, % The path taken through the body.
@@ -144,7 +146,7 @@
% The second argument is the atom in its final
% state of instantiatedness (ie. at the EXIT event).
%
- ---> wrong_answer(T, final_decl_atom)
+ ---> wrong_answer(T, init_decl_atom, final_decl_atom)
% The node is a suspected missing answer. The
% first argument is the EDT node the question came
@@ -309,11 +311,11 @@
DeclAtom = final(final_decl_atom(TraceAtom, IoActions))
).
-get_decl_question_node(wrong_answer(Node, _)) = Node.
+get_decl_question_node(wrong_answer(Node, _, _)) = Node.
get_decl_question_node(missing_answer(Node, _, _)) = Node.
get_decl_question_node(unexpected_exception(Node, _, _)) = Node.
-get_decl_question_atom(wrong_answer(_, final_decl_atom(Atom, _))) = Atom.
+get_decl_question_atom(wrong_answer(_, _, final_decl_atom(Atom, _))) = Atom.
get_decl_question_atom(missing_answer(_, init_decl_atom(Atom), _)) = Atom.
get_decl_question_atom(unexpected_exception(_, init_decl_atom(Atom), _)) =
Atom.
@@ -696,7 +698,7 @@
decl_bug_get_event_number(e_bug(EBug), Event) :-
(
- EBug = incorrect_contour(_, _, Event)
+ EBug = incorrect_contour(_, _, _, Event)
;
EBug = partially_uncovered_atom(_, Event)
;
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.30
diff -u -r1.30 declarative_oracle.m
--- browser/declarative_oracle.m 4 Jan 2005 00:26:30 -0000 1.30
+++ browser/declarative_oracle.m 4 Jan 2005 05:08:02 -0000
@@ -498,7 +498,7 @@
maybe(decl_answer(T))::out) is cc_multi.
query_oracle_kb(KB, Question, Result) :-
- Question = wrong_answer(Node, Atom),
+ Question = wrong_answer(Node, _, Atom),
get_kb_ground_map(KB, Map),
tree234_cc__search(Map, Atom, MaybeTruth),
(
@@ -571,7 +571,7 @@
assert_oracle_kb(_, skip(_), KB, KB).
-assert_oracle_kb(wrong_answer(_, Atom), truth_value(_, Truth), KB0, KB) :-
+assert_oracle_kb(wrong_answer(_, _, Atom), truth_value(_, Truth), KB0, KB) :-
get_kb_ground_map(KB0, Map0),
ProcLayout = Atom ^ final_atom ^ proc_layout,
%
@@ -633,7 +633,7 @@
:- pred retract_oracle_kb(decl_question(T), oracle_kb, oracle_kb).
:- mode retract_oracle_kb(in, in, out) is cc_multi.
-retract_oracle_kb(wrong_answer(_, Atom), KB0, KB) :-
+retract_oracle_kb(wrong_answer(_, _, Atom), KB0, KB) :-
Map0 = KB0 ^ kb_ground_map,
% delete all modes of the predicate/function
foldl(remove_atom_from_ground_map(Atom),
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.11
diff -u -r1.11 declarative_tree.m
--- browser/declarative_tree.m 16 Dec 2004 00:12:39 -0000 1.11
+++ browser/declarative_tree.m 5 Jan 2005 01:32:50 -0000
@@ -16,6 +16,7 @@
:- import_module mdb.declarative_edt.
:- import_module mdb__declarative_execution.
+:- import_module mdbcomp__program_representation.
% The type of nodes in our implementation of EDTs. The parameter
% is meant to be the type of references to trace nodes. In
@@ -37,13 +38,15 @@
<= annotated_trace(S, R).
:- mode edt_subtree_details(in, in, out, out, out) is det.
+:- pred trace_atom_subterm_is_ground(trace_atom::in, arg_pos::in,
+ term_path::in) is semidet.
+
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdb__declarative_debugger.
:- import_module mdb__io_action.
-:- import_module mdbcomp__program_representation.
:- import_module mdb__util.
:- import_module assoc_list, bool, exception, int, list, map, std_util, string.
@@ -137,9 +140,10 @@
get_answers(IoActionMap, Store, RedoId, [], Answers),
Root = missing_answer(dynamic(Ref), DeclAtom, Answers)
;
- Node = exit(_, _, _, _, _, _),
- DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
- Root = wrong_answer(dynamic(Ref), DeclAtom)
+ Node = exit(_, CallId, _, _, _, _),
+ InitDeclAtom = call_node_decl_atom(Store, CallId),
+ FinalDeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+ Root = wrong_answer(dynamic(Ref), InitDeclAtom, FinalDeclAtom)
;
Node = excp(_, CallId, _, Exception, _),
DeclAtom = call_node_decl_atom(Store, CallId),
@@ -169,9 +173,11 @@
trace_get_e_bug(IoActionMap, wrap(Store), dynamic(Ref), Bug) :-
det_edt_return_node_from_id(Store, Ref, Node),
(
- Node = exit(_, _, _, _, Event, _),
- DeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
- Bug = incorrect_contour(DeclAtom, unit, Event)
+ Node = exit(_, CallId, _, _, Event, _),
+ InitDeclAtom = call_node_decl_atom(Store, CallId),
+ FinalDeclAtom = exit_node_decl_atom(IoActionMap, Store, Node),
+ Bug = incorrect_contour(InitDeclAtom, FinalDeclAtom, unit,
+ Event)
;
Node = fail(_, CallId, _, Event),
DeclAtom = call_node_decl_atom(Store, CallId),
@@ -1606,9 +1612,6 @@
).
%-----------------------------------------------------------------------------%
-
-:- pred trace_atom_subterm_is_ground(trace_atom, arg_pos, term_path).
-:- mode trace_atom_subterm_is_ground(in, in, in) is semidet.
trace_atom_subterm_is_ground(atom(_, Args), ArgPos, _) :-
select_arg_at_pos(ArgPos, Args, ArgInfo),
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.32
diff -u -r1.32 declarative_user.m
--- browser/declarative_user.m 19 Nov 2004 11:54:17 -0000 1.32
+++ browser/declarative_user.m 5 Jan 2005 05:17:10 -0000
@@ -68,6 +68,7 @@
:- import_module mdb__io_action.
:- import_module mdb__util.
:- import_module mdb__declarative_execution.
+:- import_module mdb__declarative_tree.
:- import_module mdbcomp__program_representation.
:- import_module mdb.parse.
@@ -119,31 +120,25 @@
handle_command(browse_arg(MaybeArgNum), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
- edt_node_trace_atom(Question, TraceAtom),
+ edt_node_trace_atoms(Question, InitAtom, FinalAtom),
(
MaybeArgNum = yes(ArgNum),
- browse_atom_argument(TraceAtom, ArgNum, MaybeMark, !User, !IO),
+ browse_atom_argument(InitAtom, FinalAtom, ArgNum, MaybeMark,
+ !User, !IO),
(
MaybeMark = no,
query_user(UserQuestion, Response,
!User, !IO)
;
MaybeMark = yes(Mark),
- Which = chosen_head_vars_presentation,
- (
- Which = only_user_headvars,
- ArgPos = user_head_var(ArgNum)
- ;
- Which = all_headvars,
- ArgPos = any_head_var(ArgNum)
- ),
+ ArgPos = arg_num_to_arg_pos(ArgNum),
Node = get_decl_question_node(Question),
Answer = suspicious_subterm(Node, ArgPos, Mark),
Response = user_answer(Question, Answer)
)
;
MaybeArgNum = no,
- browse_atom(TraceAtom, MaybeMark, !User, !IO),
+ browse_atom(InitAtom, FinalAtom, MaybeMark, !User, !IO),
(
MaybeMark = no,
query_user(UserQuestion, Response,
@@ -157,14 +152,7 @@
Response = user_answer(Question, Answer)
;
MaybeMark = yes([ArgNum | Mark]),
- Which = chosen_head_vars_presentation,
- (
- Which = only_user_headvars,
- ArgPos = user_head_var(ArgNum)
- ;
- Which = all_headvars,
- ArgPos = any_head_var(ArgNum)
- ),
+ ArgPos = arg_num_to_arg_pos(ArgNum),
Node = get_decl_question_node(Question),
Answer = suspicious_subterm(Node, ArgPos, Mark),
Response = user_answer(Question, Answer)
@@ -174,7 +162,7 @@
handle_command(print_arg(From, To), UserQuestion, Response,
!User, !IO) :-
Question = get_decl_question(UserQuestion),
- edt_node_trace_atom(Question, TraceAtom),
+ edt_node_trace_atoms(Question, _, TraceAtom),
print_atom_arguments(TraceAtom, From, To, !.User, !IO),
query_user(UserQuestion, Response, !User, !IO).
@@ -244,6 +232,18 @@
io__write_string("Unknown command, 'h' for help.\n", !IO),
query_user(UserQuestion, Response, !User, !IO).
+:- func arg_num_to_arg_pos(int) = arg_pos.
+
+arg_num_to_arg_pos(ArgNum) = ArgPos :-
+ Which = chosen_head_vars_presentation,
+ (
+ Which = only_user_headvars,
+ ArgPos = user_head_var(ArgNum)
+ ;
+ Which = all_headvars,
+ ArgPos = any_head_var(ArgNum)
+ ).
+
:- func get_decl_question(user_question(T)) = decl_question(T).
get_decl_question(plain_question(Q)) = Q.
@@ -263,7 +263,7 @@
:- pred decl_question_prompt(decl_question(T), string).
:- mode decl_question_prompt(in, out) is det.
-decl_question_prompt(wrong_answer(_, _), "Valid? ").
+decl_question_prompt(wrong_answer(_, _, _), "Valid? ").
decl_question_prompt(missing_answer(_, _, _), "Complete? ").
decl_question_prompt(unexpected_exception(_, _, _), "Expected? ").
@@ -274,36 +274,42 @@
default_prompt(erroneous, "[no] ").
default_prompt(inadmissible, "[inadmissible] ").
-:- pred edt_node_trace_atom(decl_question(T)::in, trace_atom::out) is det.
+ % Find the initial and final atoms for a question. For all
+ % questions besides wrong answer questions the initial and
+ % final atoms will be the same.
+ %
+:- pred edt_node_trace_atoms(decl_question(T)::in, trace_atom::out,
+ trace_atom::out) is det.
-edt_node_trace_atom(wrong_answer(_, FinalDeclAtom),
- FinalDeclAtom ^ final_atom).
-edt_node_trace_atom(missing_answer(_, InitDeclAtom, _),
- InitDeclAtom ^ init_atom).
-edt_node_trace_atom(unexpected_exception(_, InitDeclAtom, _),
- InitDeclAtom ^ init_atom).
+edt_node_trace_atoms(wrong_answer(_, InitDeclAtom, FinalDeclAtom),
+ InitDeclAtom ^ init_atom, FinalDeclAtom ^ final_atom).
+edt_node_trace_atoms(missing_answer(_, InitDeclAtom, _),
+ InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
+edt_node_trace_atoms(unexpected_exception(_, InitDeclAtom, _),
+ InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
:- pred edt_node_io_actions(decl_question(T)::in, list(io_action)::out) is det.
-edt_node_io_actions(wrong_answer(_, FinalDeclAtom),
+edt_node_io_actions(wrong_answer(_, _, FinalDeclAtom),
FinalDeclAtom ^ final_io_actions).
edt_node_io_actions(missing_answer(_, _, _), []).
edt_node_io_actions(unexpected_exception(_, _, _), []).
-:- pred decl_bug_trace_atom(decl_bug::in, trace_atom::out) is det.
+:- pred decl_bug_trace_atom(decl_bug::in, trace_atom::out, trace_atom::out)
+ is det.
-decl_bug_trace_atom(e_bug(incorrect_contour(FinalDeclAtom, _, _)),
- FinalDeclAtom ^ final_atom).
+decl_bug_trace_atom(e_bug(incorrect_contour(InitDeclAtom, FinalDeclAtom, _,
+ _)), InitDeclAtom ^ init_atom, FinalDeclAtom ^ final_atom).
decl_bug_trace_atom(e_bug(partially_uncovered_atom(InitDeclAtom, _)),
- InitDeclAtom ^ init_atom).
+ InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
decl_bug_trace_atom(e_bug(unhandled_exception(InitDeclAtom, _, _)),
- InitDeclAtom ^ init_atom).
+ InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
decl_bug_trace_atom(i_bug(inadmissible_call(_, _, InitDeclAtom, _)),
- InitDeclAtom ^ init_atom).
+ InitDeclAtom ^ init_atom, InitDeclAtom ^ init_atom).
:- pred decl_bug_io_actions(decl_bug::in, list(io_action)::out) is det.
-decl_bug_io_actions(e_bug(incorrect_contour(FinalDeclAtom, _, _)),
+decl_bug_io_actions(e_bug(incorrect_contour(_, FinalDeclAtom, _, _)),
FinalDeclAtom ^ final_io_actions).
decl_bug_io_actions(e_bug(partially_uncovered_atom(_, _)), []).
decl_bug_io_actions(e_bug(unhandled_exception(_, _, _)), []).
@@ -351,8 +357,8 @@
browse_io_action(IoAction, MaybeMark, !User, !IO) :-
Term = io_action_to_browser_term(IoAction),
- browse_browser_term(Term, !.User ^ instr, !.User ^ outstr, MaybeDirs,
- !.User ^ browser, Browser, !IO),
+ browse_browser_term(Term, !.User ^ instr, !.User ^ outstr, no,
+ MaybeDirs, !.User ^ browser, Browser, !IO),
maybe_convert_dirs_to_path(MaybeDirs, MaybeMark),
!:User = !.User ^ browser := Browser.
@@ -361,21 +367,22 @@
is cc_multi.
browse_decl_bug(Bug, MaybeArgNum, !User, !IO) :-
- decl_bug_trace_atom(Bug, Atom),
+ decl_bug_trace_atom(Bug, InitAtom, FinalAtom),
(
MaybeArgNum = yes(ArgNum),
- browse_atom_argument(Atom, ArgNum, _, !User, !IO)
+ browse_atom_argument(InitAtom, FinalAtom, ArgNum, _, !User,
+ !IO)
;
MaybeArgNum = no,
- browse_atom(Atom, _, !User, !IO)
+ browse_atom(InitAtom, FinalAtom, _, !User, !IO)
).
-:- pred browse_atom_argument(trace_atom::in, int::in, maybe(term_path)::out,
- user_state::in, user_state::out, io__state::di, io__state::uo)
- is cc_multi.
+:- pred browse_atom_argument(trace_atom::in, trace_atom::in, int::in,
+ maybe(term_path)::out, user_state::in, user_state::out,
+ io__state::di, io__state::uo) is cc_multi.
-browse_atom_argument(Atom, ArgNum, MaybeMark, !User, !IO) :-
- Atom = atom(_, Args0),
+browse_atom_argument(InitAtom, FinalAtom, ArgNum, MaybeMark, !User, !IO) :-
+ FinalAtom = atom(_, Args0),
maybe_filter_headvars(chosen_head_vars_presentation, Args0, Args),
(
list__index1(Args, ArgNum, ArgInfo),
@@ -384,6 +391,8 @@
->
browse_browser_term(univ_to_browser_term(Arg),
!.User ^ instr, !.User ^ outstr,
+ yes(get_subterm_mode_from_atoms_for_arg(ArgNum,
+ InitAtom, FinalAtom)),
MaybeDirs, !.User ^ browser, Browser, !IO),
maybe_convert_dirs_to_path(MaybeDirs, MaybeMark),
!:User = !.User ^ browser := Browser
@@ -393,12 +402,12 @@
MaybeMark = no
).
-:- pred browse_atom(trace_atom::in, maybe(term_path)::out,
+:- pred browse_atom(trace_atom::in, trace_atom::in, maybe(term_path)::out,
user_state::in, user_state::out, io__state::di, io__state::uo)
is cc_multi.
-browse_atom(Atom, MaybeMark, !User, !IO) :-
- Atom = atom(ProcLayout, Args),
+browse_atom(InitAtom, FinalAtom, MaybeMark, !User, !IO) :-
+ FinalAtom = atom(ProcLayout, Args),
ProcId = get_proc_id_from_layout(ProcLayout),
get_user_arg_values(Args, ArgValues),
get_pred_attributes(ProcId, Module, Name, _, PredOrFunc),
@@ -406,12 +415,51 @@
BrowserTerm = synthetic_term_to_browser_term(Module++"."++Name,
ArgValues, Function),
browse_browser_term(BrowserTerm, !.User ^ instr, !.User ^ outstr,
+ yes(get_subterm_mode_from_atoms(InitAtom, FinalAtom)),
MaybeDirs, !.User ^ browser, Browser, !IO),
maybe_convert_dirs_to_path(MaybeDirs, MaybeMark),
!:User = !.User ^ browser := Browser.
+:- func get_subterm_mode_from_atoms(trace_atom, trace_atom, list(dir))
+ = browser_term_mode.
+
+get_subterm_mode_from_atoms(InitAtom, FinalAtom, Dirs) = Mode :-
+ convert_dirs_to_term_path(Dirs, Path),
+ (
+ Path = [ArgNum | TermPath],
+ ArgPos = arg_num_to_arg_pos(ArgNum),
+ Mode = get_subterm_mode_from_atoms_and_term_path(InitAtom,
+ FinalAtom, ArgPos, TermPath)
+ ;
+ Path = [],
+ Mode = not_applicable
+ ).
+
+:- func get_subterm_mode_from_atoms_and_term_path(trace_atom, trace_atom,
+ arg_pos, term_path) = browser_term_mode.
+
+get_subterm_mode_from_atoms_and_term_path(InitAtom, FinalAtom, ArgPos,
+ TermPath) = Mode :-
+ ( trace_atom_subterm_is_ground(InitAtom, ArgPos, TermPath) ->
+ Mode = input
+ ; trace_atom_subterm_is_ground(FinalAtom, ArgPos, TermPath) ->
+ Mode = output
+ ;
+ Mode = unbound
+ ).
+
+:- func get_subterm_mode_from_atoms_for_arg(int, trace_atom, trace_atom,
+ list(dir)) = browser_term_mode.
+
+get_subterm_mode_from_atoms_for_arg(ArgNum, InitAtom, FinalAtom, Dirs)
+ = Mode :-
+ convert_dirs_to_term_path(Dirs, TermPath),
+ ArgPos = arg_num_to_arg_pos(ArgNum),
+ Mode = get_subterm_mode_from_atoms_and_term_path(InitAtom, FinalAtom,
+ ArgPos, TermPath).
+
:- pred get_user_arg_values(list(trace_atom_arg)::in, list(univ)::out) is det.
-
+
get_user_arg_values([], []).
get_user_arg_values([arg_info(UserVisible, _, MaybeValue) | Args], Values) :-
get_user_arg_values(Args, Values0),
@@ -698,7 +746,7 @@
:- pred write_decl_question(decl_question(T)::in, user_state::in,
io__state::di, io__state::uo) is cc_multi.
-write_decl_question(wrong_answer(_, Atom), User) -->
+write_decl_question(wrong_answer(_, _, Atom), User) -->
write_decl_final_atom(User, "", decl_caller_type, Atom).
write_decl_question(missing_answer(_, Call, Solns), User) -->
@@ -723,7 +771,7 @@
write_decl_bug(e_bug(EBug), User) -->
(
- { EBug = incorrect_contour(Atom, _, _) },
+ { EBug = incorrect_contour(_, Atom, _, _) },
io__write_string(User ^ outstr, "Found incorrect contour:\n"),
write_decl_final_atom(User, "", decl_caller_type, Atom)
;
Index: browser/parse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/parse.m,v
retrieving revision 1.22
diff -u -r1.22 parse.m
--- browser/parse.m 16 Dec 2004 03:17:18 -0000 1.22
+++ browser/parse.m 5 Jan 2005 01:35:18 -0000
@@ -35,6 +35,7 @@
% "write"
% "set" [[setoptions] varvalue]
% "mark" [path]
+% "mode" [path]
% "quit"
%
% formatoptions:
@@ -117,6 +118,8 @@
; cd
; mark(path)
; mark
+ ; mode_query(path)
+ ; mode_query
; pwd
; help
; set(maybe_option_table(setting_option), setting)
@@ -370,6 +373,15 @@
;
parse_path(ArgTokens, Path),
Command = mark(Path)
+ )
+ ;
+ CmdToken = name("mode")
+ ->
+ ( ArgTokens = [] ->
+ Command = mode_query
+ ;
+ parse_path(ArgTokens, Path),
+ Command = mode_query(Path)
)
;
CmdToken = name("set")
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.68
diff -u -r1.68 Mmakefile
--- tests/debugger/declarative/Mmakefile 16 Dec 2004 00:12:40 -0000 1.68
+++ tests/debugger/declarative/Mmakefile 5 Jan 2005 04:43:04 -0000
@@ -11,6 +11,7 @@
backtrack \
big \
binary_search \
+ browser_mode \
browse_arg \
catch \
closure_dependency \
@@ -190,6 +191,10 @@
browse_arg.out: browse_arg browse_arg.inp
$(MDB) ./browse_arg < browse_arg.inp > browse_arg.out 2>&1 \
+ || { grep . $@ /dev/null; exit 1; }
+
+browser_mode.out: browser_mode browser_mode.inp
+ $(MDB_STD) ./browser_mode < browser_mode.inp > browser_mode.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
builtin_call_rep.out: builtin_call_rep builtin_call_rep.inp
Index: tests/debugger/declarative/browser_mode.exp
===================================================================
RCS file: tests/debugger/declarative/browser_mode.exp
diff -N tests/debugger/declarative/browser_mode.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/browser_mode.exp 5 Jan 2005 04:57:19 -0000
@@ -0,0 +1,59 @@
+ E1: C1 CALL pred browser_mode.main/2-0 (det) browser_mode.m:11
+mdb> mdb> Contexts will not be printed.
+mdb> echo on
+Command echo enabled.
+mdb> break p
+ 0: + stop interface pred browser_mode.p/2-0 (nondet)
+mdb> c
+ E2: C2 CALL pred browser_mode.p/2-0 (nondet)
+mdb> f
+ E3: C2 EXIT pred browser_mode.p/2-0 (nondet)
+mdb> dd
+p('a', 30)
+Valid? browse
+browser> mode
+Not Applicable
+browser> cd 1
+browser> mode
+Input
+browser> cd ../2
+browser> mode
+Output
+browser> quit
+p('a', 30)
+Valid? a
+Diagnosis aborted.
+ E3: C2 EXIT pred browser_mode.p/2-0 (nondet)
+mdb> break r
+ 1: + stop interface pred browser_mode.r/2-0 (semidet)
+mdb> c
+ E4: C2 REDO pred browser_mode.p/2-0 (nondet)
+mdb> c
+ E5: C2 EXIT pred browser_mode.p/2-0 (nondet)
+mdb> c
+ E6: C2 REDO pred browser_mode.p/2-0 (nondet)
+mdb> c
+ E7: C3 CALL pred browser_mode.r/2-0 (semidet)
+mdb> c
+ E8: C3 FAIL pred browser_mode.r/2-0 (semidet)
+mdb> dd
+Call r('b', _)
+No solutions.
+Complete? b 1
+browser> mode
+Input
+browser> quit
+Call r('b', _)
+No solutions.
+Complete? b
+browser> mode 2
+Unbound
+browser> mode 1
+Input
+browser> quit
+Call r('b', _)
+No solutions.
+Complete? a
+Diagnosis aborted.
+ E8: C3 FAIL pred browser_mode.r/2-0 (semidet)
+mdb> quit -y
Index: tests/debugger/declarative/browser_mode.inp
===================================================================
RCS file: tests/debugger/declarative/browser_mode.inp
diff -N tests/debugger/declarative/browser_mode.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/browser_mode.inp 5 Jan 2005 02:21:07 -0000
@@ -0,0 +1,31 @@
+register --quiet
+context none
+echo on
+break p
+c
+f
+dd
+browse
+mode
+cd 1
+mode
+cd ../2
+mode
+quit
+a
+break r
+c
+c
+c
+c
+c
+dd
+b 1
+mode
+quit
+b
+mode 2
+mode 1
+quit
+a
+quit -y
Index: tests/debugger/declarative/browser_mode.m
===================================================================
RCS file: tests/debugger/declarative/browser_mode.m
diff -N tests/debugger/declarative/browser_mode.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/browser_mode.m 5 Jan 2005 04:01:38 -0000
@@ -0,0 +1,57 @@
+:- module browser_mode.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.
+:- import_module int, std_util.
+
+main -->
+ ( { p('a', X), test(X) } ->
+ io__write_string("yes\n")
+ ;
+ io__write_string("no\n")
+ ).
+
+:- pred test(int).
+:- mode test(in) is semidet.
+
+test(_) :-
+ semidet_fail.
+
+:- pred p(character, int).
+:- mode p(in, out) is nondet.
+
+p(A, D) :-
+ q(A, B),
+ (
+ r(B, C)
+ ->
+ (
+ s(C, D)
+ ;
+ D = 31
+ )
+ ;
+ not(
+ q(B, _)
+ ),
+ D = 32
+ ).
+
+:- pred q(character, character).
+:- mode q(in, out) is nondet.
+
+q('a', 'a').
+q('a', 'b').
+q('c', 'c').
+
+:- pred r(character, int).
+:- mode r(in, out) is semidet.
+
+r('a', 10).
+
+:- pred s(int, int).
+:- mode s(in, out) is det.
+
+s(N, 3 * N).
+
--------------------------------------------------------------------------
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