[m-rev.] diff: save_to_file
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu May 13 18:49:30 AEST 2004
Add an mdb command to save a term from the program being debugged to a file.
browser/browse.m:
Provide mechanisms to create browser terms from their components,
and to save browser terms to a named file.
trace/mercury_trace_browse.[ch]:
Provide access to these predicates from C code.
trace/mercury_trace_internal.c:
Implement a new mdb command, save_to_file, which saves a goal,
exception, procedure body or specified variable to a file.
doc/user_guide.texi:
doc/mdb_categories:
Document the new mdb command.
trace/mercury_trace_vars.[ch]:
Factor out the code for constructing the (components of) browser terms
from goals and variables from the code for browsing the resulting
terms, to allow them to be used also for saving those terms to a file.
tests/debugger/mdb_command_test.inp:
Test the documentation of the new command.
tests/debugger/completion.exp:
Update this test case both for the new command and for the previous one
I added (var_name_stats).
tests/debugger/browser_test.{m,inp,exp}:
Extend this test case to also test the behavior of the new command.
Zoltan.
cvs server: Diffing .
cvs server: Diffing analysis
cvs server: Diffing bindist
cvs server: Diffing boehm_gc
cvs server: Diffing boehm_gc/Mac_files
cvs server: Diffing boehm_gc/cord
cvs server: Diffing boehm_gc/cord/private
cvs server: Diffing boehm_gc/doc
cvs server: Diffing boehm_gc/include
cvs server: Diffing boehm_gc/include/private
cvs server: Diffing boehm_gc/tests
cvs server: Diffing browser
Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.42
diff -u -b -r1.42 browse.m
--- browser/browse.m 5 Apr 2004 07:18:51 -0000 1.42
+++ browser/browse.m 13 May 2004 08:40:32 -0000
@@ -112,6 +112,40 @@
%---------------------------------------------------------------------------%
+ % This predicate converts terms represented as univs to browser terms.
+
+:- pred univ_to_browser_term(univ::in, browser_term::out) is det.
+
+ % This predicate converts plain terms from the representation used
+ % in the trace directory to browser terms.
+
+:- pred plain_term_to_browser_term(T::in, browser_term::out) is det.
+
+ % This predicate converts synthetic terms from the representation used
+ % in the trace directory (as a list of arguments, the last of which
+ % represents the return value for function calls) to the representation
+ % used in the browser directory, in which a function call's return
+ % value is stored separately from the other arguments.
+ %
+ % The reason why the trace directory does not use the latter
+ % representation is that it would require C code to construct values
+ % of type maybe(T).
+
+:- pred synthetic_term_to_browser_term(string::in, list(univ)::in, bool::in,
+ browser_term::out) is det.
+
+ % save_term_to_file(FileName, Format, BrowserTerm, Out, !IO):
+ % Save BrowserTerm to the file FileName. If there is an error,
+ % print an error message to Out.
+ %
+ % The format of the saved term can be influenced by the Format
+ % argument, but how this works is not specified.
+
+:- pred save_term_to_file(string::in, string::in, browser_term::in,
+ io__output_stream::in, io::di, io::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+
:- implementation.
:- import_module mdb__parse.
@@ -147,7 +181,17 @@
:- pragma export(browse__print_format_synthetic(in, in, in, in, in, in, in,
di, uo), "ML_BROWSE_print_format_synthetic").
+:- pragma export(plain_term_to_browser_term(in, out),
+ "ML_BROWSE_plain_term_to_browser_term").
+:- pragma export(univ_to_browser_term(in, out),
+ "ML_BROWSE_univ_to_browser_term").
+:- pragma export(synthetic_term_to_browser_term(in, in, in, out),
+ "ML_BROWSE_synthetic_term_to_browser_term").
+:- pragma export(save_term_to_file(in, in, in, in, di, uo),
+ "ML_BROWSE_save_term_to_file").
+
%---------------------------------------------------------------------------%
+%
% If the term browser is called from the internal debugger, input is
% done via a call to the readline library (if available), using streams
% MR_mdb_in and MR_mdb_out. If it is called from the external debugger,
@@ -168,6 +212,118 @@
%---------------------------------------------------------------------------%
%
+% Saving terms to files
+%
+
+save_term_to_file(FileName, _Format, BrowserTerm, OutStream, !IO) :-
+ % io__write_string(FileName, !IO),
+ % io__nl(!IO),
+ % io__write(BrowserTerm, !IO),
+ % io__nl(!IO),
+ io__tell(FileName, FileStreamRes, !IO),
+ (
+ FileStreamRes = ok,
+ (
+ BrowserTerm = plain_term(Term),
+ save_univ(0, Term, !IO),
+ io__nl(!IO)
+ ;
+ BrowserTerm = synthetic_term(Functor, Args, MaybeRes),
+ io__write_string(Functor, !IO),
+ io__write_string("(\n", !IO),
+ save_args(1, Args, !IO),
+ io__write_string("\n)\n", !IO),
+ (
+ MaybeRes = no
+ ;
+ MaybeRes = yes(Result),
+ io__write_string("=\n", !IO),
+ save_univ(1, Result, !IO),
+ io__write_string("\n", !IO)
+ )
+ ),
+ io__told(!IO)
+ ;
+ FileStreamRes = error(Error),
+ io__error_message(Error, Msg),
+ io__write_string(OutStream, Msg, !IO)
+ ).
+
+:- pred save_univ(int::in, univ::in, io::di, io::uo) is cc_multi.
+
+save_univ(Indent, Univ, !IO) :-
+ save_term(Indent, univ_value(Univ), !IO).
+
+:- pred save_term(int::in, T::in, io::di, io::uo) is cc_multi.
+
+save_term(Indent, Term, !IO) :-
+ ( dynamic_cast_to_list(Term, List) ->
+ (
+ List = [],
+ write_indent(Indent, !IO),
+ io__write_string("[]", !IO)
+ ;
+ List = [_ | _],
+ MakeUniv = (func(Element) = (ElementUniv) :-
+ ElementUniv = univ(Element)
+ ),
+ Univs = list__map(MakeUniv, List),
+ write_indent(Indent, !IO),
+ io__write_string("[\n", !IO),
+ save_args(Indent + 1, Univs, !IO),
+ io__write_string("\n", !IO),
+ write_indent(Indent, !IO),
+ io__write_string("]", !IO)
+ )
+ ;
+ deconstruct_cc(Term, Functor, _Arity, Args),
+ write_indent(Indent, !IO),
+ io__write_string(Functor, !IO),
+ (
+ Args = []
+ ;
+ Args = [_ | _],
+ io__write_string("(\n", !IO),
+ save_args(Indent + 1, Args, !IO),
+ io__write_string("\n", !IO),
+ write_indent(Indent, !IO),
+ io__write_string(")", !IO)
+ )
+ ).
+
+:- some [T2] pred dynamic_cast_to_list(T1::in, list(T2)::out) is semidet.
+
+dynamic_cast_to_list(X, L) :-
+ % The code of this predicate is copied from pprint.m.
+ [ArgTypeDesc] = type_args(type_of(X)),
+ (_ `with_type` ArgType) `has_type` ArgTypeDesc,
+ dynamic_cast(X, L `with_type` list(ArgType)).
+
+:- pred save_args(int::in, list(univ)::in, io::di, io::uo) is cc_multi.
+
+save_args(_Indent, [], !IO).
+save_args(Indent, [Univ | Univs], !IO) :-
+ save_univ(Indent, Univ, !IO),
+ (
+ Univs = []
+ ;
+ Univs = [_ | _],
+ io__write_string(",\n", !IO),
+ save_args(Indent, Univs, !IO)
+ ).
+
+:- pred write_indent(int::in, io::di, io::uo) is det.
+
+write_indent(Indent, !IO) :-
+ ( Indent =< 0 ->
+ true
+ ;
+ io__write_char(' ', !IO),
+ write_indent(Indent - 1, !IO)
+ ).
+
+%---------------------------------------------------------------------------%
+%
% Non-interactive display
%
@@ -267,17 +423,11 @@
MaybeMark = Info ^ maybe_mark,
!:State = Info ^ state.
-% This predicate converts synthetic terms from the representation used in the
-% trace directory (as a list of arguments, the last of which represents the
-% return value for function calls) to the representation used in the browser
-% directory, in which a function call's return value is stored separately from
-% the other arguments.
-%
-% The reason why the trace directory does not use the latter representation
-% is that it would require C code to construct values of type maybe(T).
+univ_to_browser_term(Univ, BrowserTerm) :-
+ BrowserTerm = plain_term(Univ).
-:- pred synthetic_term_to_browser_term(string::in, list(univ)::in, bool::in,
- browser_term::out) is det.
+plain_term_to_browser_term(Term, BrowserTerm) :-
+ BrowserTerm = plain_term(univ(Term)).
synthetic_term_to_browser_term(FunctorString, Args, IsFunc, BrowserTerm) :-
(
cvs server: Diffing bytecode
cvs server: Diffing compiler
cvs server: Diffing compiler/notes
cvs server: Diffing debian
cvs server: Diffing deep_profiler
cvs server: Diffing deep_profiler/notes
cvs server: Diffing doc
Index: doc/mdb_categories
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/mdb_categories,v
retrieving revision 1.20
diff -u -b -r1.20 mdb_categories
--- doc/mdb_categories 4 May 2004 07:23:21 -0000 1.20
+++ doc/mdb_categories 13 May 2004 08:40:32 -0000
@@ -26,7 +26,8 @@
document_category 400 browsing
browsing - Commands that let users explore the state of the computation.
The browsing commands are `vars', `print', `browse',
- `stack', `up', `down', `level', `current' and `view'.
+ `stack', `up', `down', `level', `current', `view' and
+ `save_to_file'.
end
document_category 500 breakpoint
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.384
diff -u -b -r1.384 user_guide.texi
--- doc/user_guide.texi 4 May 2004 07:23:21 -0000 1.384
+++ doc/user_guide.texi 13 May 2004 08:40:34 -0000
@@ -2525,7 +2525,7 @@
type @samp{help} at the @samp{browser>} prompt.
@sp 1
@item browse [-fpv]
- at item browse [-fpv] goal
+ at itemx browse [-fpv] goal
Invokes the interactive term browser to browse
the goal of the current call in its present state of instantiation.
@sp 1
@@ -2757,6 +2757,27 @@
@sp 1
The option @samp{-t} (or @samp{--timeout}) specifies
the maximum number of seconds to wait for the server to start.
+ at sp 1
+ at item save_to_file goal @var{filename}
+ at kindex save_to_file (mdb command)
+Writes the goal of the current call in its present state of instantiation
+to the specified file.
+ at sp 1
+ at item save_to_file exception @var{filename}
+Writes the value of the exception at an EXCP port
+to the specified file.
+Reports an error if the current event does not refer to such a port.
+ at sp 1
+ at item save_to_file @var{name} @var{filename}
+ at itemx save_to_file @var{num} @var{filename}
+Writes the value of the variable in the current environment
+with the given ordinal number or with the given name
+to the specified file.
+ at c @sp 1
+ at c @item save_to_file proc_body @var{filename}
+ at c Writes the representation of the body of the current procedure,
+ at c if it is available,
+ at c to the specified file.
@end table
@sp 1
cvs server: Diffing extras
cvs server: Diffing extras/aditi
cvs server: Diffing extras/cgi
cvs server: Diffing extras/complex_numbers
cvs server: Diffing extras/complex_numbers/samples
cvs server: Diffing extras/complex_numbers/tests
cvs server: Diffing extras/concurrency
cvs server: Diffing extras/curs
cvs server: Diffing extras/curs/samples
cvs server: Diffing extras/curses
cvs server: Diffing extras/curses/sample
cvs server: Diffing extras/dynamic_linking
cvs server: Diffing extras/error
cvs server: Diffing extras/graphics
cvs server: Diffing extras/graphics/mercury_opengl
cvs server: Diffing extras/graphics/mercury_tcltk
cvs server: Diffing extras/graphics/samples
cvs server: Diffing extras/graphics/samples/calc
cvs server: Diffing extras/graphics/samples/maze
cvs server: Diffing extras/graphics/samples/pent
cvs server: Diffing extras/lazy_evaluation
cvs server: Diffing extras/lex
cvs server: Diffing extras/lex/samples
cvs server: Diffing extras/lex/tests
cvs server: Diffing extras/logged_output
cvs server: Diffing extras/moose
cvs server: Diffing extras/moose/samples
cvs server: Diffing extras/moose/tests
cvs server: Diffing extras/morphine
cvs server: Diffing extras/morphine/non-regression-tests
cvs server: Diffing extras/morphine/scripts
cvs server: Diffing extras/morphine/source
cvs server: Diffing extras/odbc
cvs server: Diffing extras/posix
cvs server: Diffing extras/quickcheck
cvs server: Diffing extras/quickcheck/tutes
cvs server: Diffing extras/references
cvs server: Diffing extras/references/samples
cvs server: Diffing extras/references/tests
cvs server: Diffing extras/stream
cvs server: Diffing extras/trailed_update
cvs server: Diffing extras/trailed_update/samples
cvs server: Diffing extras/trailed_update/tests
cvs server: Diffing extras/xml
cvs server: Diffing extras/xml/samples
cvs server: Diffing java
cvs server: Diffing java/runtime
cvs server: Diffing library
cvs server: Diffing profiler
cvs server: Diffing robdd
cvs server: Diffing runtime
cvs server: Diffing runtime/GETOPT
cvs server: Diffing runtime/machdeps
cvs server: Diffing samples
cvs server: Diffing samples/c_interface
cvs server: Diffing samples/c_interface/c_calls_mercury
cvs server: Diffing samples/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/c_interface/mercury_calls_c
cvs server: Diffing samples/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/c_interface/mercury_calls_fortran
cvs server: Diffing samples/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/diff
cvs server: Diffing samples/muz
cvs server: Diffing samples/rot13
cvs server: Diffing samples/solutions
cvs server: Diffing samples/tests
cvs server: Diffing samples/tests/c_interface
cvs server: Diffing samples/tests/c_interface/c_calls_mercury
cvs server: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/tests/c_interface/mercury_calls_c
cvs server: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs server: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/tests/diff
cvs server: Diffing samples/tests/muz
cvs server: Diffing samples/tests/rot13
cvs server: Diffing samples/tests/solutions
cvs server: Diffing samples/tests/toplevel
cvs server: Diffing scripts
cvs server: Diffing tests
cvs server: Diffing tests/benchmarks
cvs server: Diffing tests/debugger
Index: tests/debugger/browser_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/browser_test.exp,v
retrieving revision 1.16
diff -u -b -r1.16 browser_test.exp
--- tests/debugger/browser_test.exp 13 Oct 2003 08:02:05 -0000 1.16
+++ tests/debugger/browser_test.exp 13 May 2004 08:40:34 -0000
@@ -1,8 +1,16 @@
- E1: C1 1 CALL pred browser_test.main/2-0 (det) browser_test.m:11
+ E1: C1 1 CALL pred browser_test.main/2-0 (det) browser_test.m:16
mdb> echo on
Command echo enabled.
-mdb> goto 3
- E2: C2 2 EXIT pred browser_test.big_data/1-0 (det) browser_test.m:18 (browser_test.m:12)
+mdb> register --quiet
+mdb> break big_data
+ 0: + stop interface pred browser_test.big_data/1-0 (det)
+mdb> continue
+ E2: C2 2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:34 (browser_test.m:20)
+mdb> finish
+ E3: C2 2 EXIT pred browser_test.big_data/1-0 (det) browser_test.m:34 (browser_test.m:20)
+mdb> delete *
+ 0: E stop interface pred browser_test.big_data/1-0 (det)
+mdb> save_to_file 1 browser_test.save.1
mdb> set format pretty
mdb> print *
Data (arg 1)
@@ -100,6 +108,68 @@
mdb> print 1^1^2^3
mdb: the path 3 does not exist.
mdb> retry
- E3: C2 2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:18 (browser_test.m:12)
+ E2: C2 2 CALL pred browser_test.big_data/1-0 (det) browser_test.m:34 (browser_test.m:20)
+mdb> break list_data
+ 0: + stop interface pred browser_test.list_data/1-0 (det)
mdb> continue
big(big(big(small, 1, small), 2, small), 3, big(big(small, 4, big(small, 5, small)), 6, small)).
+ E4: C3 2 CALL pred browser_test.list_data/1-0 (det) browser_test.m:63 (browser_test.m:23)
+mdb> finish
+ E5: C3 2 EXIT pred browser_test.list_data/1-0 (det) browser_test.m:63 (browser_test.m:23)
+mdb> save_to_file Data browser_test.save.2
+mdb> continue
+seq(1, [big(big(small, 1, small), 2, small), small, big(small, 4, big(small, 5, small))], 5).
+browser_test.save.1:
+big(
+ big(
+ big(
+ small,
+ 1,
+ small
+ ),
+ 2,
+ small
+ ),
+ 3,
+ big(
+ big(
+ small,
+ 4,
+ big(
+ small,
+ 5,
+ small
+ )
+ ),
+ 6,
+ small
+ )
+)
+
+browser_test.save.2:
+seq(
+ 1,
+ [
+ big(
+ big(
+ small,
+ 1,
+ small
+ ),
+ 2,
+ small
+ ),
+ small,
+ big(
+ small,
+ 4,
+ big(
+ small,
+ 5,
+ small
+ )
+ )
+ ],
+ 5
+)
+
Index: tests/debugger/browser_test.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/browser_test.inp,v
retrieving revision 1.8
diff -u -b -r1.8 browser_test.inp
--- tests/debugger/browser_test.inp 30 Jan 2003 05:59:26 -0000 1.8
+++ tests/debugger/browser_test.inp 13 May 2004 08:40:34 -0000
@@ -1,5 +1,10 @@
echo on
-goto 3
+register --quiet
+break big_data
+continue
+finish
+delete *
+save_to_file 1 browser_test.save.1
set format pretty
print *
set -A format verbose
@@ -34,5 +39,8 @@
print Data/1/2
print 1^1^2^3
retry
+break list_data
+continue
+finish
+save_to_file Data browser_test.save.2
continue
-
Index: tests/debugger/browser_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/browser_test.m,v
retrieving revision 1.1
diff -u -b -r1.1 browser_test.m
--- tests/debugger/browser_test.m 14 May 1999 02:25:29 -0000 1.1
+++ tests/debugger/browser_test.m 13 May 2004 08:40:34 -0000
@@ -1,17 +1,33 @@
:- module browser_test.
:- interface.
:- import_module io.
+
:- pred main(io__state::di, io__state::uo) is det.
+
:- implementation.
+:- import_module list.
+
:- type big
---> big(big, int, big)
- ; small.
+ ; small
+ ; seq(int, list(big), int).
-main -->
- { big_data(Data) },
- io__print(Data),
- io__write_string(".\n").
+main(!IO) :-
+ % In case we have these files lying around.
+ io__remove_file("browser_test.save.1", _, !IO),
+ io__remove_file("browser_test.save.2", _, !IO),
+ big_data(Data),
+ io__print(Data, !IO),
+ io__write_string(".\n", !IO),
+ list_data(List),
+ io__print(List, !IO),
+ io__write_string(".\n", !IO),
+ print_file("browser_test.save.1", !IO),
+ print_file("browser_test.save.2", !IO),
+ % Clean up after the test.
+ io__remove_file("browser_test.save.1", _, !IO),
+ io__remove_file("browser_test.save.2", _, !IO).
:- pred big_data(big::out) is det.
@@ -42,3 +58,48 @@
)
).
+:- pred list_data(big::out) is det.
+
+list_data(Data) :-
+ Element1 = big(
+ big(
+ small,
+ 1,
+ small
+ ),
+ 2,
+ small
+ ),
+ Element2 = small,
+ Element3 = big(
+ small,
+ 4,
+ big(
+ small,
+ 5,
+ small
+ )
+ ),
+ Data = seq(1, [Element1, Element2, Element3], 5).
+
+:- pred print_file(string::in, io::di, io::uo) is det.
+
+print_file(FileName, !IO) :-
+ io__open_input(FileName, OpenRes, !IO),
+ (
+ OpenRes = ok(Stream),
+ io__read_file_as_string(Stream, ReadRes, !IO),
+ (
+ ReadRes = ok(Contents),
+ io__write_string(FileName, !IO),
+ io__write_string(":\n", !IO),
+ io__write_string(Contents, !IO),
+ io__write_string("\n", !IO)
+ ;
+ ReadRes = error(_, _),
+ io__write_string("read failed\n", !IO)
+ )
+ ;
+ OpenRes = error(_),
+ io__write_string("open failed\n", !IO)
+ ).
Index: tests/debugger/completion.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/completion.exp,v
retrieving revision 1.15
diff -u -b -r1.15 completion.exp
--- tests/debugger/completion.exp 16 Mar 2004 05:08:13 -0000 1.15
+++ tests/debugger/completion.exp 13 May 2004 08:40:34 -0000
@@ -3,30 +3,32 @@
Command echo enabled.
mdb> register --quiet
mdb>
-? delete io_query return
-P disable label_stats s
-alias document level save
-all_class_decls document_category maxdepth scope
-all_regs down mindepth scroll
-all_type_ctors e mm_stacks set
-b echo mmc_options source
-break enable modules stack
-browse exception next stack_regs
-c excp nondet_stack step
-cc_query f p subgoal
-class_decl finish pneg_stack table
-clear_histogram flag print table_io
-consumer forward print_optionals term_size
-context g printlevel type_ctor
-continue gen_stack proc_stats unalias
-current goto procedures unhide_events
-cut_stack h query up
-d help quit v
-dd histogram_all r vars
-dd_dd histogram_exp register view
-debug_vars ignore retry
+? disable level save_to_file
+P document maxdepth scope
+alias document_category mindepth scroll
+all_class_decls down mm_stacks set
+all_regs e mmc_options source
+all_type_ctors echo modules stack
+b enable next stack_regs
+break exception nondet_stack step
+browse excp p subgoal
+c f pneg_stack table
+cc_query finish print table_io
+class_decl flag print_optionals term_size
+clear_histogram forward printlevel type_ctor
+consumer g proc_stats unalias
+context gen_stack procedures unhide_events
+continue goto query up
+current h quit v
+cut_stack help r var_name_stats
+d histogram_all register vars
+dd histogram_exp retry view
+dd_dd ignore return
+debug_vars io_query s
+delete label_stats save
h help histogram_all histogram_exp
-vars view
+var_name_stats vars view
+var_name_stats vars
help vars
vars
Prints the names of all the known variables in the current
Index: tests/debugger/mdb_command_test.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/mdb_command_test.inp,v
retrieving revision 1.27
diff -u -b -r1.27 mdb_command_test.inp
--- tests/debugger/mdb_command_test.inp 4 May 2004 07:23:24 -0000 1.27
+++ tests/debugger/mdb_command_test.inp 13 May 2004 08:40:34 -0000
@@ -22,6 +22,7 @@
current xyzzy xyzzy xyzzy xyzzy xyzzy
set xyzzy xyzzy xyzzy xyzzy xyzzy
view xyzzy xyzzy xyzzy xyzzy xyzzy
+save_to_file xyzzy xyzzy xyzzy xyzzy xyzzy
break xyzzy xyzzy xyzzy xyzzy xyzzy
ignore xyzzy xyzzy xyzzy xyzzy xyzzy
disable xyzzy xyzzy xyzzy xyzzy xyzzy
cvs server: Diffing tests/debugger/declarative
cvs server: Diffing tests/dppd
cvs server: Diffing tests/general
cvs server: Diffing tests/general/accumulator
cvs server: Diffing tests/general/string_format
cvs server: Diffing tests/general/structure_reuse
cvs server: Diffing tests/grade_subdirs
cvs server: Diffing tests/hard_coded
cvs server: Diffing tests/hard_coded/exceptions
cvs server: Diffing tests/hard_coded/purity
cvs server: Diffing tests/hard_coded/sub-modules
cvs server: Diffing tests/hard_coded/typeclasses
cvs server: Diffing tests/invalid
cvs server: Diffing tests/invalid/purity
cvs server: Diffing tests/misc_tests
cvs server: Diffing tests/mmc_make
cvs server: Diffing tests/mmc_make/lib
cvs server: Diffing tests/recompilation
cvs server: Diffing tests/tabling
cvs server: Diffing tests/term
cvs server: Diffing tests/valid
cvs server: Diffing tests/warnings
cvs server: Diffing tools
cvs server: Diffing trace
Index: trace/mercury_trace_browse.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_browse.c,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_trace_browse.c
--- trace/mercury_trace_browse.c 26 Jan 2004 21:09:47 -0000 1.30
+++ trace/mercury_trace_browse.c 13 May 2004 08:40:35 -0000
@@ -45,6 +45,61 @@
static MR_bool MR_trace_is_portray_format(const char *str,
MR_Browse_Format *format);
+MR_Word
+MR_type_value_to_browser_term(MR_TypeInfo type_info, MR_Word value)
+{
+ MR_Word browser_term;
+
+ MR_TRACE_CALL_MERCURY(
+ ML_BROWSE_plain_term_to_browser_term((MR_Word) type_info,
+ value, &browser_term);
+ );
+ return browser_term;
+}
+
+MR_Word
+MR_univ_to_browser_term(MR_Word univ)
+{
+ MR_Word browser_term;
+
+ MR_TRACE_CALL_MERCURY(
+ ML_BROWSE_univ_to_browser_term(univ, &browser_term);
+ );
+ return browser_term;
+}
+
+MR_Word
+MR_synthetic_to_browser_term(const char *functor, MR_Word arg_list,
+ MR_bool is_func)
+{
+ MR_Word browser_term;
+
+ MR_TRACE_CALL_MERCURY(
+ ML_BROWSE_synthetic_term_to_browser_term(
+ (MR_String) (MR_Integer) functor, arg_list, is_func,
+ &browser_term);
+ );
+ return browser_term;
+}
+
+void
+MR_trace_save_term(const char *filename, MR_Word browser_term)
+{
+ MercuryFile mdb_out;
+ MR_String mercury_filename;
+ MR_String mercury_format;
+
+ MR_trace_browse_ensure_init();
+
+ mercury_filename = (MR_String) (MR_Integer) filename;
+ mercury_format = (MR_String) (MR_Integer) "default";
+ MR_c_file_to_mercury_file(MR_mdb_out, &mdb_out);
+ MR_TRACE_CALL_MERCURY(
+ ML_BROWSE_save_term_to_file(mercury_filename, mercury_format,
+ browser_term, &mdb_out);
+ );
+}
+
void
MR_trace_browse(MR_Word type_info, MR_Word value, MR_Browse_Format format)
{
Index: trace/mercury_trace_browse.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_browse.h,v
retrieving revision 1.15
diff -u -b -r1.15 mercury_trace_browse.h
--- trace/mercury_trace_browse.h 18 Feb 2002 07:01:29 -0000 1.15
+++ trace/mercury_trace_browse.h 13 May 2004 08:40:35 -0000
@@ -20,6 +20,23 @@
#include "mercury_tags.h" /* for MR_DEFINE_MERCURY_ENUM_CONST */
/*
+** Convert a term (expressed either as a typeinfo/value pair or as a univ)
+** or a synthetic term to a browser term.
+*/
+
+extern MR_Word MR_type_value_to_browser_term(MR_TypeInfo type_info,
+ MR_Word value);
+extern MR_Word MR_univ_to_browser_term(MR_Word univ);
+extern MR_Word MR_synthetic_to_browser_term(const char *functor,
+ MR_Word arg_list, MR_bool is_func);
+
+/*
+** Save the given browser term to the named file.
+*/
+
+extern void MR_trace_save_term(const char *filename, MR_Word browser_term);
+
+/*
** The following types must correspond with browse_caller_type and
** portray_format in browser/browser_info.m.
*/
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.170
diff -u -b -r1.170 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 4 May 2004 07:23:24 -0000 1.170
+++ trace/mercury_trace_internal.c 13 May 2004 08:40:36 -0000
@@ -407,6 +407,7 @@
static MR_TraceCmdFunc MR_trace_cmd_current;
static MR_TraceCmdFunc MR_trace_cmd_set;
static MR_TraceCmdFunc MR_trace_cmd_view;
+static MR_TraceCmdFunc MR_trace_cmd_save_to_file;
static MR_TraceCmdFunc MR_trace_cmd_break;
static MR_TraceCmdFunc MR_trace_cmd_ignore;
static MR_TraceCmdFunc MR_trace_cmd_enable;
@@ -1075,8 +1076,10 @@
MR_trace_internal_init_from_local(void)
{
FILE *fp;
+ const char *init;
- if ((fp = fopen(MDBRC_FILENAME, "r")) != NULL) {
+ init = MDBRC_FILENAME;
+ if ((fp = fopen(init, "r")) != NULL) {
MR_trace_source_from_open_file(fp);
fclose(fp);
}
@@ -2169,9 +2172,8 @@
} else if (close_window) {
MR_trace_maybe_close_source_window(verbose);
} else {
- msg = MR_trace_new_source_window(window_cmd,
- server_cmd, server_name, timeout,
- force, verbose, split);
+ msg = MR_trace_new_source_window(window_cmd, server_cmd,
+ server_name, timeout, force, verbose, split);
if (msg != NULL) {
fflush(MR_mdb_out);
fprintf(MR_mdb_err, "mdb: %s.\n", msg);
@@ -2184,6 +2186,74 @@
}
static MR_Next
+MR_trace_cmd_save_to_file(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
+ MR_Event_Info *event_info, MR_Event_Details *event_details,
+ MR_Code **jumpaddr)
+{
+ MR_bool verbose = MR_FALSE;
+ MR_Word browser_term;
+ const char *problem = NULL;
+
+ if (word_count != 3) {
+ MR_trace_usage("browsing", "save_to_file");
+ } else {
+ if (MR_streq(words[1], "goal")) {
+ const char *name;
+ MR_Word arg_list;
+ MR_bool is_func;
+
+ problem = NULL;
+ MR_convert_goal_to_synthetic_term(&name, &arg_list,
+ &is_func);
+ browser_term = MR_synthetic_to_browser_term(name,
+ arg_list, is_func);
+ } else if (MR_streq(words[1], "exception")) {
+ MR_Word exception;
+
+ exception = MR_trace_get_exception_value();
+ if (exception == (MR_Word) NULL) {
+ problem = "missing exception value";
+ } else {
+ browser_term = MR_univ_to_browser_term(
+ exception);
+ }
+ } else if (MR_streq(words[1], "proc_body")) {
+ const MR_Proc_Layout *entry;
+
+ entry = event_info->MR_event_sll->MR_sll_entry;
+ if (entry->MR_sle_proc_rep == NULL) {
+ problem = "current procedure has no body info";
+ } else {
+ browser_term = MR_type_value_to_browser_term(
+ (MR_TypeInfo) ML_proc_rep_type(),
+ (MR_Word) entry->MR_sle_proc_rep);
+ }
+ } else {
+ MR_Var_Spec var_spec;
+ MR_TypeInfo type_info;
+ MR_Word value;
+
+ MR_convert_arg_to_var_spec(words[1], &var_spec);
+ problem = MR_convert_var_spec_to_type_value(var_spec,
+ &type_info, &value);
+ if (problem == NULL) {
+ browser_term = MR_type_value_to_browser_term(
+ type_info, value);
+ }
+ }
+
+ if (problem != NULL) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "mdb: %s.\n", problem);
+ } else {
+ MR_trace_save_term(words[2], browser_term);
+ }
+ }
+
+ return KEEP_INTERACTING;
+}
+
+static MR_Next
MR_trace_cmd_break(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Event_Details *event_details,
MR_Code **jumpaddr)
@@ -6917,6 +6987,8 @@
NULL, MR_trace_null_completer },
{ "browsing", "view", MR_trace_cmd_view,
MR_trace_view_cmd_args, MR_trace_null_completer },
+ { "browsing", "save_to_file", MR_trace_cmd_save_to_file,
+ NULL, MR_trace_var_completer },
{ "breakpoint", "break", MR_trace_cmd_break,
MR_trace_break_cmd_args, MR_trace_breakpoint_completer },
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.56
diff -u -b -r1.56 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 12 Feb 2004 01:35:22 -0000 1.56
+++ trace/mercury_trace_vars.c 13 May 2004 08:40:37 -0000
@@ -25,6 +25,8 @@
#include "mercury_trace_util.h"
#include "mercury_trace_vars.h"
+#include "mdb.browse.mh"
+
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -790,9 +792,10 @@
}
}
-const char *
-MR_trace_browse_one_goal(FILE *out, MR_GoalBrowser browser,
- MR_Browse_Caller_Type caller, MR_Browse_Format format)
+void
+MR_convert_goal_to_synthetic_term(const char **functor_ptr,
+ MR_Word *arg_list_ptr,
+ MR_bool *is_func_ptr)
{
const MR_Proc_Layout *proc_layout;
MR_ConstString proc_name;
@@ -808,7 +811,6 @@
int next;
int i;
int *var_slot_array;
- MR_bool saved_io_tabling_enabled;
proc_layout = MR_point.MR_point_level_entry;
MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity,
@@ -856,9 +858,25 @@
}
);
+ *functor_ptr = proc_name;
+ *arg_list_ptr = arg_list;
+ *is_func_ptr = is_func;
+}
+
+const char *
+MR_trace_browse_one_goal(FILE *out, MR_GoalBrowser browser,
+ MR_Browse_Caller_Type caller, MR_Browse_Format format)
+{
+ const char *functor;
+ MR_Word arg_list;
+ MR_bool is_func;
+ MR_bool saved_io_tabling_enabled;
+
+ MR_convert_goal_to_synthetic_term(&functor, &arg_list, &is_func);
+
saved_io_tabling_enabled = MR_io_tabling_enabled;
MR_io_tabling_enabled = MR_FALSE;
- (*browser)(proc_name, arg_list, is_func, caller, format);
+ (*browser)(functor, arg_list, is_func, caller, format);
MR_io_tabling_enabled = saved_io_tabling_enabled;
return NULL;
}
@@ -1280,6 +1298,28 @@
} else {
MR_fatal_error("internal error: bad var_spec kind");
return NULL;
+ }
+}
+
+const char *
+MR_convert_var_spec_to_type_value(MR_Var_Spec var_spec,
+ MR_TypeInfo *type_info_ptr, MR_Word *value_ptr)
+{
+ int i;
+ MR_bool is_ambiguous;
+ const char *problem;
+
+ problem = MR_lookup_var_spec(var_spec, &i, &is_ambiguous);
+ if (problem != NULL) {
+ return problem;
+ }
+
+ if (! is_ambiguous) {
+ *type_info_ptr = MR_point.MR_point_vars[i].MR_var_type;
+ *value_ptr = MR_point.MR_point_vars[i].MR_var_value;
+ return NULL;
+ } else {
+ return "variable name is not unique";
}
}
Index: trace/mercury_trace_vars.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.h,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_trace_vars.h
--- trace/mercury_trace_vars.h 20 Oct 2003 07:29:55 -0000 1.23
+++ trace/mercury_trace_vars.h 13 May 2004 08:40:37 -0000
@@ -123,7 +123,7 @@
** string giving the problem.
*/
-extern const char * MR_trace_return_hlds_var_info(int hlds_num,
+extern const char *MR_trace_return_hlds_var_info(int hlds_num,
MR_TypeInfo *type_info_ptr,
MR_Word *value_ptr);
@@ -240,7 +240,7 @@
** Return a non-NULL error message if this is not possible.
*/
-extern const char * MR_trace_print_size_one(FILE *out,
+extern const char *MR_trace_print_size_one(FILE *out,
char *word_spec);
/*
@@ -248,7 +248,26 @@
** specified file. Return a non-NULL error message if this is not possible.
*/
-extern const char * MR_trace_print_size_all(FILE *out);
+extern const char *MR_trace_print_size_all(FILE *out);
+
+/*
+** Return the current goal as the components of a synthetic term.
+*/
+
+extern void MR_convert_goal_to_synthetic_term(
+ const char **functor_ptr,
+ MR_Word *arg_list_ptr, MR_bool *is_func_ptr);
+
+
+/*
+** Given a variable specification, return the type_info and the value of the
+** chosen variable. Return a non-NULL error message if this is not possible.
+*/
+
+extern const char *MR_convert_var_spec_to_type_value(
+ MR_Var_Spec var_spec,
+ MR_TypeInfo *type_info_ptr,
+ MR_Word *value_ptr);
/*
** Return the name (if any) of the variable with the given HLDS variable number
cvs server: Diffing util
cvs server: Diffing vim
cvs server: Diffing vim/after
cvs server: Diffing vim/ftplugin
cvs server: Diffing vim/syntax
--------------------------------------------------------------------------
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