diff: finish hooking up browser into mdb
Fergus Henderson
fjh at cs.mu.OZ.AU
Mon Nov 16 03:46:41 AEDT 1998
Estimated hours taken: 2.75
Change the mdb `print' command so that it invokes the non-interactive
version of the term browser, and change the way the browser is invoked
so that the browser state is preserved across multiple invocations
of `print' or `browse' in a single mdb session.
browser/browse.m:
Make `browser_state' an abstract type.
Add new predicate `browse__init_state' to initialize that ADT.
Change the interface to `browse__browse' so that it takes and
returns the old and new browser_states.
Add a new predicate `browse__print' to replace the old
`browse__portray_root' predicate; this is the non-interactive
version of the browser. It calls io__write_univ if the term
is small enough, and browse__portray (with flat format) otherwise.
Export the `browse__print' and `browse__init_state' predicates to C.
Delete the predicates for formatting terms as strings, since that
code was a potential double-maintenance problem and was not needed.
library/io.m:
Export `io__write_univ', for use by browser/browse.m.
trace/mercury_trace_browse.h:
trace/mercury_trace_browse.c:
New files. These provide an interface to the browser
which preserves the browser state in a C static variable.
trace/Mmakefile:
Add the new files mercury_trace_browse.{h,c} to the appropriate
file lists.
trace/mercury_trace_internal.c:
Change the `browse' and `print' mdb commands to use the new
functions defined in mercury_trace_browse.{h,c} rather than
calling browser__browse and io__print (respectively), and don't
print a newline afterwards, since the browser does that itself.
Delete the old hack to avoid printing out HLDS and ModuleInfo,
since it's not necessary any more.
doc/user_guide.texi:
Update the documentation for the `browse' and `print' commands
to reflect these changes.
tests/debugger/*.exp:
tests/debugger/*.exp2:
Update the expected output from the debugger to reflect these changes.
Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.2
diff -u -r1.2 browse.m
--- browse.m 1998/11/15 14:00:15 1.2
+++ browse.m 1998/11/15 16:41:36
@@ -20,54 +20,128 @@
:- interface.
-:- import_module parse.
-:- import_module io, std_util, list.
+:- import_module io.
+
+ % an abstract data type that holds persistent browser settings,
+ % e.g. the maximum print depth
+:- type browser_state.
+
+ % initialize the browser state with default values
+:- pred browse__init_state(browser_state, io__state, io__state).
+:- mode browse__init_state(out, di, uo) is det.
% The interactive term browser.
-:- pred browse__browse(T, io__state, io__state).
-:- mode browse__browse(in, di, uo) is det.
+:- pred browse__browse(T, browser_state, browser_state, io__state, io__state).
+:- mode browse__browse(in, in, out, di, uo) is det.
-:- pred browse__portray_root(browser_state, string).
-:- mode browse__portray_root(in, out) is det.
+ % The non-interactive term browser.
+:- pred browse__print(T, browser_state, io__state, io__state).
+:- mode browse__print(in, in, di, uo) is det.
+%---------------------------------------------------------------------------%
+:- implementation.
-:- type browser_state
- ---> browser_state(
- univ, % term to browse (as univ)
- int, % depth of tree
- int, % max nodes printed
- list(dir), % root rel `present working directory'
- portray_format, % format for ls.
- int, % X clipping for verbose display
- int % Y clipping for verbose display
- ).
+:- import_module parse, util, frame.
+:- import_module string, list, parser, require, std_util, int, char.
%---------------------------------------------------------------------------%
-:- implementation.
+%
+% We export these predicates to C for use by the tracer:
+% they are used in trace/mercury_trace_browser.c.
+%
+
+:- pragma export(browse__init_state(out, di, uo), "ML_BROWSE_init_state").
+:- pragma export(browse__browse(in, in, out, di, uo), "ML_BROWSE_browse").
+:- pragma export(browse__print(in, in, di, uo), "ML_BROWSE_print").
+:- pragma export(browse__browser_state_type(out),
+ "ML_BROWSE_browser_state_type").
+
+%---------------------------------------------------------------------------%
+
+browse__init_state(State) -->
+ { default_state(State) }.
-:- import_module parse, util, frame, string, list, parser, require,
- std_util, int, char.
+% return the type_info for a browser_state type
+:- pred browse__browser_state_type(type_info).
+:- mode browse__browser_state_type(out) is det.
+
+browse__browser_state_type(Type) :-
+ default_state(State),
+ Type = type_of(State).
-:- pragma export(browse__browse(in, di, uo), "ML_browse").
+%---------------------------------------------------------------------------%
+%
+% Non-interactive display
+%
+
+browse__print(Term, State0) -->
+ { set_term(Term, State0, State) },
+ browse__print(State).
+
+:- pred browse__print(browser_state, io__state, io__state).
+:- mode browse__print(in, di, uo) is det.
+
+browse__print(State) -->
+ %
+ % io__write handles the special cases such as lists,
+ % operators, etc. better, so we prefer to use it if we
+ % can. However, io__write doesn't have a depth or size limit,
+ % so we need to check the size first; if the term is small
+ % enough, we use io__write (actually io__write_univ), otherwise
+ % we use portray_fmt(..., flat).
+ %
+ { get_term(State, Univ) },
+ { term_size(Univ, Size) },
+ { max_print_size(MaxSize) },
+ ( { Size =< MaxSize } ->
+ io__write_univ(Univ),
+ io__nl
+ ;
+ portray_fmt(State, flat)
+ ).
+
+ % The maximum estimated size for which we use `io__write'.
+:- pred max_print_size(int::out) is det.
+max_print_size(60).
+
+ % Estimate the total term size, in characters.
+ % We count the number of characters in the functor,
+ % plus two characters for each argument: "(" and ")"
+ % for the first, and ", " for each of the rest,
+ % plus the sizes of the arguments themselves.
+ % This is only approximate since it doesn't take into
+ % account all the special cases such as operators.
+:- pred term_size(univ::in, int::out) is det.
+term_size(Univ, TotalSize) :-
+ deconstruct(Univ, Functor, Arity, Args),
+ string__length(Functor, FunctorSize),
+ list__map(term_size, Args, ArgSizes),
+ AddSizes = (pred(X::in, Y::in, Z::out) is det :- Z = X + Y),
+ list__foldl(AddSizes, ArgSizes, Arity * 2, TotalArgsSize),
+ TotalSize = TotalArgsSize + FunctorSize.
+%---------------------------------------------------------------------------%
+%
+% Interactive display
+%
-browse__browse(Object) -->
+browse__browse(Object, State0, State) -->
{ type_to_univ(Object, Univ) },
- { default_state(Univ, State) },
+ { set_term(Univ, State0, State1) },
% startup_message,
- browse_2(State).
+ browse_main_loop(State1, State).
-:- pred browse_2(browser_state, io__state, io__state).
-:- mode browse_2(in, di, uo) is det.
-browse_2(State) -->
+:- pred browse_main_loop(browser_state, browser_state, io__state, io__state).
+:- mode browse_main_loop(in, out, di, uo) is det.
+browse_main_loop(State0, State) -->
prompt,
parse__read_command(Command),
( { Command = quit } ->
% io__write_string("quitting...\n")
- { true }
+ { State = State0 }
;
- run_command(Command, State, NewState),
- browse_2(NewState)
+ run_command(Command, State0, State1),
+ browse_main_loop(State1, State)
).
:- pred startup_message(io__state::di, io__state::uo) is det.
@@ -85,7 +159,7 @@
:- mode run_command(in, in, out, di, uo) is det.
run_command(Command, State, NewState) -->
( { Command = unknown } ->
- io__write_string("error: unknown command or syntax error.\nType \"help\" for help.\n"),
+ io__write_string("Error: unknown command or syntax error.\nType \"help\" for help.\n"),
{ NewState = State }
; { Command = help } ->
help,
@@ -127,7 +201,7 @@
{ NewState = State }
)
; { Command = print } ->
- portray_fmt(State, flat),
+ browse__print(State),
{ NewState = State }
; { Command = pwd } ->
{ get_dirs(State, Path) },
@@ -165,6 +239,9 @@
).
%---------------------------------------------------------------------------%
+%
+% Various pretty-print routines
+%
:- pred portray(browser_state, io__state, io__state).
:- mode portray(in, di, uo) is det.
@@ -253,86 +330,9 @@
io__nl.
%---------------------------------------------------------------------------%
- % Non-interactive display
-
- % Display from the root term.
- % This avoid errors due to dereferencing non-existent subterms.
-browse__portray_root(State, Str) :-
- get_fmt(State, Fmt),
- set_path(root_rel([]), State, NewState),
- (
- Fmt = flat,
- portray_flat_string(NewState, Str)
- ;
- Fmt = pretty,
- portray_pretty_string(NewState, Str)
- ;
- Fmt = verbose,
- portray_verbose_string(NewState, Str)
- ).
-
-:- pred portray_string(browser_state, string).
-:- mode portray_string(in, out) is det.
-portray_string(State, Str) :-
- get_fmt(State, Fmt),
- (
- Fmt = flat,
- portray_flat_string(State, Str)
- ;
- Fmt = pretty,
- portray_pretty_string(State, Str)
- ;
- Fmt = verbose,
- portray_verbose_string(State, Str)
- ).
-
-
-:- pred portray_flat_string(browser_state, string).
-:- mode portray_flat_string(in, out) is det.
-portray_flat_string(State, Str) :-
- get_term(State, Univ),
- get_size(State, MaxSize),
- get_depth(State, MaxDepth),
- get_dirs(State, Dir),
- ( deref_subterm(Univ, Dir, SubUniv) ->
- term_to_string(SubUniv, MaxSize, MaxDepth, Str)
- ;
- error("error: no such subterm")
- ).
-
- % XXX: return maybe(string) instead?
-:- pred portray_pretty_string(browser_state, string).
-:- mode portray_pretty_string(in, out) is det.
-portray_pretty_string(State, Str) :-
- get_term(State, Univ),
- get_size(State, MaxSize),
- get_depth(State, MaxDepth),
- get_dirs(State, Dir),
- ( deref_subterm(Univ, Dir, SubUniv) ->
- term_to_string_pretty(SubUniv, MaxSize, MaxDepth, Str)
- ;
- error("error: no such subterm")
- ).
-
-:- pred portray_verbose_string(browser_state, string).
-:- mode portray_verbose_string(in, out) is det.
-portray_verbose_string(State, Str) :-
- get_term(State, Univ),
- get_size(State, MaxSize),
- get_depth(State, MaxDepth),
- get_dirs(State, Dir),
- get_clipx(State, X),
- get_clipy(State, Y),
- ( deref_subterm(Univ, Dir, SubUniv) ->
- term_to_string_verbose(SubUniv, MaxSize, MaxDepth,
- X, Y, Str)
- ;
- error("error: no such subterm")
- ).
-
-
-%---------------------------------------------------------------------------%
- % Single-line representation of a term.
+%
+% Single-line representation of a term.
+%
:- pred term_to_string(univ, int, int, string).
:- mode term_to_string(in, in, in, out) is det.
@@ -415,9 +415,11 @@
%---------------------------------------------------------------------------%
- % Simple indented view of a term. This isn't really
- % pretty printing since parentheses and commas are omitted.
- % XXX: Should do proper pretty printing?
+%
+% Simple indented view of a term. This isn't really
+% pretty printing since parentheses and commas are omitted.
+% XXX: Should do proper pretty printing?
+%
:- pred term_to_string_pretty(univ, int, int, string).
:- mode term_to_string_pretty(in, in, in, out) is det.
@@ -502,8 +504,10 @@
%---------------------------------------------------------------------------%
- % Verbose printing. Tree layout with numbered branches.
- % Numbering makes it easier to change to subterms.
+%
+% Verbose printing. Tree layout with numbered branches.
+% Numbering makes it easier to change to subterms.
+%
:- pred term_to_string_verbose(univ, int, int, int, int, string).
:- mode term_to_string_verbose(in, in, in, in, in, out) is det.
@@ -570,7 +574,9 @@
frame__vglue(TopFrame, RestTreesFrame, Frame).
%---------------------------------------------------------------------------%
- % Miscellaneous path handling
+%
+% Miscellaneous path handling
+%
:- pred write_path(list(dir), io__state, io__state).
:- mode write_path(in, di, uo) is det.
@@ -646,13 +652,34 @@
).
%---------------------------------------------------------------------------%
+%
+% The definition of the browser_state type and its access routines.
+%
+
+:- type browser_state
+ ---> browser_state(
+ univ, % term to browse (as univ)
+ int, % depth of tree
+ int, % max nodes printed
+ list(dir), % root rel `present working directory'
+ portray_format, % format for ls.
+ int, % X clipping for verbose display
+ int % Y clipping for verbose display
+ ).
+
% access predicates
-:- pred default_state(univ, browser_state).
-:- mode default_state(in, out) is det.
-default_state(Univ, State) :-
- State = browser_state(Univ, 3, DefaultDepth, [], verbose, 79, 25),
- default_depth(DefaultDepth).
+:- pred default_state(browser_state).
+:- mode default_state(out) is det.
+default_state(State) :-
+ % We need to supply an object to initialize the state,
+ % but this object won't be used, since the first call
+ % to browse__browse will overwrite it. So we just supply
+ % a dummy object -- it doesn't matter what its type or value is.
+ DummyObject = "",
+ type_to_univ(DummyObject, Univ),
+ default_depth(DefaultDepth),
+ State = browser_state(Univ, 3, DefaultDepth, [], verbose, 79, 25).
:- pred get_term(browser_state, univ).
:- mode get_term(in, out) is det.
@@ -735,13 +762,24 @@
set_fmt(NewFmt, browser_state(Univ, Depth, Size, Path, _OldFmt, X, Y),
browser_state(Univ, Depth, Size, Path, NewFmt, X, Y)).
-:- pred set_term(univ, browser_state, browser_state).
+:- pred set_term(T, browser_state, browser_state).
:- mode set_term(in, in, out) is det.
-set_term(NewUniv, browser_state(_OldUniv, Dep, Siz, Path, Fmt, X, Y),
+set_term(Term, State0, State) :-
+ type_to_univ(Term, Univ),
+ set_univ(Univ, State0, State1),
+ % Display from the root term.
+ % This avoid errors due to dereferencing non-existent subterms.
+ set_path(root_rel([]), State1, State).
+
+:- pred set_univ(univ, browser_state, browser_state).
+:- mode set_univ(in, in, out) is det.
+set_univ(NewUniv, browser_state(_OldUniv, Dep, Siz, Path, Fmt, X, Y),
browser_state(NewUniv, Dep, Siz, Path, Fmt, X, Y)).
%---------------------------------------------------------------------------%
- % display predicates.
+%
+% Display predicates.
+%
:- pred show_settings(browser_state, io__state, io__state).
:- mode show_settings(in, di, uo) is det.
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.149
diff -u -r1.149 user_guide.texi
--- user_guide.texi 1998/11/15 14:00:24 1.149
+++ user_guide.texi 1998/11/15 15:31:57
@@ -3535,29 +3535,30 @@
@itemx print @var{num}
Prints the value of the variable in the current environment
with the given name, or with the given ordinal number.
- at sp 1
-At the moment this command prints the entire value of the variable,
-even if this is very big.
+This is a non-interactive version of the @samp{browse}
+command (see below). Various settings
+which affect the way that terms are printed out
+(including e.g. the maximum term depth) can be set using
+the @samp{set} command in the browser.
@sp 1
@item print *
Prints the values of all the known variables in the current environment.
@sp 1
-At the moment this command prints the entire value of every variable,
-even if this is very big.
- at sp 1
@item browse @var{name}
@itemx browse @var{num}
Invokes an interactive term browser to browse the value of the
variable in the current environment with the given ordinal number or
with the given name.
@sp 1
-Unlike the @samp{print} command, the depth and size of printed terms
-may be controlled. The interactive term browser allows you
+The interactive term browser allows you
to selectively examine particular subterms.
+The depth and size of printed terms
+may be controlled.
The displayed terms may also be clipped to fit
within a single screen.
@sp 1
For further documentation on the interactive term browser,
+invoke the @samp{browse} command from within @samp{mdb} and then
type @samp{help} at the @samp{browser>} prompt.
@sp 1
@item stack [-d]
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.170
diff -u -r1.170 io.m
--- io.m 1998/11/09 02:43:57 1.170
+++ io.m 1998/11/15 16:13:50
@@ -1030,6 +1030,11 @@
:- pred io__set_op_table(ops__table, io__state, io__state).
:- mode io__set_op_table(di, di, uo) is det.
+% For use by browser/browse.m:
+
+:- pred io__write_univ(univ, io__state, io__state).
+:- mode io__write_univ(in, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1790,9 +1795,6 @@
io__write(Term) -->
{ type_to_univ(Term, Univ) },
io__write_univ(Univ).
-
-:- pred io__write_univ(univ, io__state, io__state).
-:- mode io__write_univ(in, di, uo) is det.
io__write_univ(Univ) -->
{ ops__max_priority(MaxPriority) },
Index: tests/debugger/debugger_regs.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/debugger_regs.exp,v
retrieving revision 1.4
diff -u -r1.4 debugger_regs.exp
--- debugger_regs.exp 1998/11/04 04:20:15 1.4
+++ debugger_regs.exp 1998/11/15 16:31:26
@@ -6,46 +6,46 @@
3: 2 2 EXIT pred debugger_regs:data/41-0 (det)
mdb> print *
HeadVar__1 [1, 2, 3, 4, 5]
- HeadVar__10 a8
- HeadVar__11 a9
- HeadVar__12 b0
- HeadVar__13 b1
- HeadVar__14 b2
- HeadVar__15 b3
- HeadVar__16 b4
- HeadVar__17 b5
- HeadVar__18 b6
- HeadVar__19 b7
- HeadVar__2 a0
- HeadVar__20 b8
- HeadVar__21 b9
- HeadVar__22 c0
- HeadVar__23 c1
- HeadVar__24 c2
- HeadVar__25 c3
- HeadVar__26 c4
- HeadVar__27 c5
- HeadVar__28 c6
- HeadVar__29 c7
- HeadVar__3 a1
- HeadVar__30 c8
- HeadVar__31 c9
- HeadVar__32 d0
- HeadVar__33 d1
- HeadVar__34 d2
- HeadVar__35 d3
- HeadVar__36 d4
- HeadVar__37 d5
- HeadVar__38 d6
- HeadVar__39 d7
- HeadVar__4 a2
- HeadVar__40 d8
- HeadVar__41 d9
- HeadVar__5 a3
- HeadVar__6 a4
- HeadVar__7 a5
- HeadVar__8 a6
- HeadVar__9 a7
+ HeadVar__10 "a8"
+ HeadVar__11 "a9"
+ HeadVar__12 "b0"
+ HeadVar__13 "b1"
+ HeadVar__14 "b2"
+ HeadVar__15 "b3"
+ HeadVar__16 "b4"
+ HeadVar__17 "b5"
+ HeadVar__18 "b6"
+ HeadVar__19 "b7"
+ HeadVar__2 "a0"
+ HeadVar__20 "b8"
+ HeadVar__21 "b9"
+ HeadVar__22 "c0"
+ HeadVar__23 "c1"
+ HeadVar__24 "c2"
+ HeadVar__25 "c3"
+ HeadVar__26 "c4"
+ HeadVar__27 "c5"
+ HeadVar__28 "c6"
+ HeadVar__29 "c7"
+ HeadVar__3 "a1"
+ HeadVar__30 "c8"
+ HeadVar__31 "c9"
+ HeadVar__32 "d0"
+ HeadVar__33 "d1"
+ HeadVar__34 "d2"
+ HeadVar__35 "d3"
+ HeadVar__36 "d4"
+ HeadVar__37 "d5"
+ HeadVar__38 "d6"
+ HeadVar__39 "d7"
+ HeadVar__4 "a2"
+ HeadVar__40 "d8"
+ HeadVar__41 "d9"
+ HeadVar__5 "a3"
+ HeadVar__6 "a4"
+ HeadVar__7 "a5"
+ HeadVar__8 "a6"
+ HeadVar__9 "a7"
mdb> continue
a0a1a2a3a4a5a6a7a8a9
b0b1b2b3b4b5b6b7b8b9
Index: tests/debugger/existential_type_classes.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/existential_type_classes.exp,v
retrieving revision 1.3
diff -u -r1.3 existential_type_classes.exp
--- existential_type_classes.exp 1998/11/04 04:20:15 1.3
+++ existential_type_classes.exp 1998/11/15 16:31:26
@@ -29,15 +29,15 @@
mdb> continue -a
10: 6 2 CALL pred existential_type_classes:do_foo/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
mdb>
11: 7 3 CALL pred existential_type_classes:foo/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
mdb>
12: 8 4 CALL pred existential_type_classes:Introduced_pred_for_existential_type_classes__fooable__string_0_____existential_type_classes__foo_2/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
mdb> continue -a
13: 9 5 CALL pred existential_type_classes:string_foo/2-0 (det)
14: 9 5 EXIT pred existential_type_classes:string_foo/2-0 (det)
@@ -45,7 +45,7 @@
16: 7 3 EXIT pred existential_type_classes:foo/2-0 (det)
17: 6 2 EXIT pred existential_type_classes:do_foo/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
HeadVar__2 4
mdb> continue -a
18: 10 2 CALL func existential_type_classes:my_exist_t/1-0 (det)
@@ -137,7 +137,7 @@
57: 28 2 EXIT func existential_type_classes:call_my_univ_value/2-0 (det)
58: 30 2 CALL pred existential_type_classes:do_foo/2-0 (det)
mdb> P
- HeadVar__1 something
+ HeadVar__1 "something"
mdb> continue -S
84
4
Index: tests/debugger/interpreter.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/interpreter.exp,v
retrieving revision 1.5
diff -u -r1.5 interpreter.exp
--- interpreter.exp 1998/11/04 04:20:17 1.5
+++ interpreter.exp 1998/11/15 16:31:27
@@ -10,23 +10,23 @@
1 HeadVar__2
2 HeadVar__4
mdb> print *
- HeadVar__1 term(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)))
+ HeadVar__1 term(varset(0, empty, empty), functor(atom(":-"), .(functor/3, []), context("interpreter.m", 22)))
HeadVar__2 []
HeadVar__4 state('<<c_pointer>>')
mdb> goto 30
30: 16 12 CALL pred interpreter:database_assert_clause/4-0 (det)
mdb> print *
- HeadVar__1 [clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
+ HeadVar__1 .(clause(varset(0, empty, empty), functor(atom/1, ./2, context/2), functor(atom/1, [], context/2)), .(clause(varset/3, functor/3, functor/3), .(clause/3, [])))
HeadVar__2 varset(0, empty, empty)
- HeadVar__3 functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))
+ HeadVar__3 functor(atom(":-"), .(functor(atom/1, ./2, context/2), []), context("interpreter.m", 26))
mdb> finish -a
31: 16 12 ELSE pred interpreter:database_assert_clause/4-0 (det) e;
32: 16 12 EXIT pred interpreter:database_assert_clause/4-0 (det)
mdb> print *
- HeadVar__1 [clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
+ HeadVar__1 .(clause(varset(0, empty, empty), functor(atom/1, ./2, context/2), functor(atom/1, [], context/2)), .(clause(varset/3, functor/3, functor/3), .(clause/3, [])))
HeadVar__2 varset(0, empty, empty)
- HeadVar__3 functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))
- HeadVar__4 [clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("inter!
preter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
+ HeadVar__3 functor(atom(":-"), .(functor(atom/1, ./2, context/2), []), context("interpreter.m", 26))
+ HeadVar__4 .(clause(varset(0, empty, empty), functor(atom/1, ./2, context/2), functor(atom/1, [], context/2)), .(clause(varset/3, functor/3, functor/3), .(clause/3, ./2)))
mdb>
33: 17 12 CALL pred interpreter:consult_until_eof/4-0 (det)
mdb> finish -n
Index: tests/debugger/multi_parameter.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/multi_parameter.exp,v
retrieving revision 1.2
diff -u -r1.2 multi_parameter.exp
--- multi_parameter.exp 1998/11/04 04:20:17 1.2
+++ multi_parameter.exp 1998/11/15 16:31:26
@@ -3,29 +3,29 @@
mdb>
2: 2 2 CALL pred multi_parameter:foo/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
mdb>
3: 3 3 CALL pred multi_parameter:a/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
mdb>
4: 4 4 CALL pred multi_parameter:Introduced_pred_for_multi_parameter__m__character_0_int_0_____multi_parameter__a_2/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
mdb>
5: 4 4 EXIT pred multi_parameter:Introduced_pred_for_multi_parameter__m__character_0_int_0_____multi_parameter__a_2/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
HeadVar__2 122
mdb>
6: 3 3 EXIT pred multi_parameter:a/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
HeadVar__2 122
mdb>
7: 2 2 EXIT pred multi_parameter:foo/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
HeadVar__2 122
mdb>
122
Index: tests/debugger/existential_type_classes.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/existential_type_classes.exp2,v
retrieving revision 1.1
diff -u -r1.1 existential_type_classes.exp2
--- existential_type_classes.exp2 1998/11/08 23:42:09 1.1
+++ existential_type_classes.exp2 1998/11/15 16:34:07
@@ -29,15 +29,15 @@
mdb> continue -a
10: 6 2 CALL pred existential_type_classes:do_foo/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
mdb>
11: 7 3 CALL pred existential_type_classes:foo/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
mdb>
12: 8 4 CALL pred existential_type_classes:Introduced_pred_for_existential_type_classes__fooable__string_0_____existential_type_classes__foo_2/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
mdb> continue -a
13: 9 5 CALL pred existential_type_classes:string_foo/2-0 (det)
14: 10 6 CALL pred string:length/2-0 (det)
@@ -47,7 +47,7 @@
18: 7 3 EXIT pred existential_type_classes:foo/2-0 (det)
19: 6 2 EXIT pred existential_type_classes:do_foo/2-0 (det)
mdb> P
- HeadVar__1 blah
+ HeadVar__1 "blah"
HeadVar__2 4
mdb> continue -a
20: 11 2 CALL func existential_type_classes:my_exist_t/1-0 (det)
@@ -139,7 +139,7 @@
59: 29 2 EXIT func existential_type_classes:call_my_univ_value/2-0 (det)
60: 31 2 CALL pred existential_type_classes:do_foo/2-0 (det)
mdb> P
- HeadVar__1 something
+ HeadVar__1 "something"
mdb> continue -S
84
4
Index: tests/debugger/interpreter.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/interpreter.exp2,v
retrieving revision 1.1
diff -u -r1.1 interpreter.exp2
--- interpreter.exp2 1998/11/08 23:42:10 1.1
+++ interpreter.exp2 1998/11/15 16:36:08
@@ -9,7 +9,7 @@
1 HeadVar__2
2 HeadVar__4
mdb> print *
- HeadVar__1 interpreter.m
+ HeadVar__1 "interpreter.m"
HeadVar__2 []
HeadVar__4 state('<<c_pointer>>')
mdb> goto 30
@@ -18,7 +18,7 @@
mdb> print *
HeadVar__1 two('<<c_pointer>>', "<standard input>", empty, empty)
HeadVar__2 '<<c_pointer>>'
- HeadVar__3 interpreter.m
+ HeadVar__3 "interpreter.m"
mdb> finish -a
31: 17 9 THEN pred tree234:set2/4-1 (det) c2;t;
32: 17 9 SWTC pred tree234:set2/4-1 (det) c2;t;c2;s1;
@@ -26,7 +26,7 @@
mdb> print *
HeadVar__1 two('<<c_pointer>>', "<standard input>", empty, empty)
HeadVar__2 '<<c_pointer>>'
- HeadVar__3 interpreter.m
+ HeadVar__3 "interpreter.m"
HeadVar__4 three('<<c_pointer>>', "interpreter.m", '<<c_pointer>>', "<standard input>", empty, empty, empty)
mdb>
34: 16 8 EXIT pred tree234:set/4-1 (det)
@@ -37,4 +37,4 @@
mdb>
36: 18 7 CALL pred io:set_stream_names/3-0 (det)
mdb> continue
-?-
\ No newline at end of file
+?-
Index: tests/debugger/multi_parameter.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/multi_parameter.exp2,v
retrieving revision 1.1
diff -u -r1.1 multi_parameter.exp2
--- multi_parameter.exp2 1998/11/08 23:42:11 1.1
+++ multi_parameter.exp2 1998/11/15 16:35:00
@@ -3,33 +3,33 @@
mdb>
2: 2 2 CALL pred multi_parameter:foo/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
mdb>
3: 3 3 CALL pred multi_parameter:a/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
mdb>
4: 4 4 CALL pred multi_parameter:Introduced_pred_for_multi_parameter__m__character_0_int_0_____multi_parameter__a_2/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
mdb>
5: 5 5 CALL pred char:to_int/2-0 (det)
mdb> print *
- Character z
+ Character 'z'
mdb>
6: 5 5 EXIT pred char:to_int/2-0 (det)
mdb> print *
- Character z
+ Character 'z'
Int 122
mdb>
7: 4 4 EXIT pred multi_parameter:Introduced_pred_for_multi_parameter__m__character_0_int_0_____multi_parameter__a_2/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
HeadVar__2 122
mdb>
8: 3 3 EXIT pred multi_parameter:a/2-0 (det)
mdb> print *
- HeadVar__1 z
+ HeadVar__1 'z'
HeadVar__2 122
mdb> continue -S
122
Index: trace/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/Mmakefile,v
retrieving revision 1.4
diff -u -r1.4 Mmakefile
--- Mmakefile 1998/11/09 04:09:37 1.4
+++ Mmakefile 1998/11/15 14:48:44
@@ -27,6 +27,7 @@
HDRS = \
mercury_trace.h \
mercury_trace_alias.h \
+ mercury_trace_browse.h \
mercury_trace_external.h \
mercury_trace_help.h \
mercury_trace_internal.h \
@@ -38,6 +39,7 @@
CFILES = \
mercury_trace.c \
mercury_trace_alias.c \
+ mercury_trace_browse.c \
mercury_trace_external.c \
mercury_trace_help.c \
mercury_trace_internal.c \
Index: trace/mercury_trace_browse.c
===================================================================
RCS file: mercury_trace_browse.c
diff -N mercury_trace_browse.c
--- /dev/null Mon Nov 16 03:45:03 1998
+++ mercury_trace_browse.c Mon Nov 16 02:47:18 1998
@@ -0,0 +1,79 @@
+/*
+** Copyright (C) 1998 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.
+*/
+
+/*
+** mercury_trace_browse.c
+**
+** Main author: fjh
+**
+** This file provides the C interface to browser/browse.m.
+*/
+
+/*
+** Some header files refer to files automatically generated by the Mercury
+** compiler for modules in the browser and library directories.
+**
+** XXX figure out how to prevent these names from encroaching on the user's
+** name space.
+*/
+
+#include "mercury_imp.h"
+#include "mercury_trace_browse.h"
+#include "mercury_trace_util.h"
+#include "mercury_deep_copy.h"
+#include "browse.h"
+#include "std_util.h"
+#include <stdio.h>
+
+static Word MR_trace_browser_state;
+static Word MR_trace_browser_state_type;
+
+static void MR_trace_browse_ensure_init(void);
+
+void
+MR_trace_browse(Word type_info, Word value)
+{
+ MR_trace_browse_ensure_init();
+ MR_TRACE_CALL_MERCURY(
+ ML_BROWSE_browse(type_info, value, MR_trace_browser_state,
+ &MR_trace_browser_state);
+ );
+ MR_trace_browser_state = MR_make_permanent(MR_trace_browser_state,
+ (Word *) MR_trace_browser_state_type);
+}
+
+void
+MR_trace_print(Word type_info, Word value)
+{
+ MR_trace_browse_ensure_init();
+ MR_TRACE_CALL_MERCURY(
+ ML_BROWSE_print(type_info, value, MR_trace_browser_state);
+ );
+}
+
+static void
+MR_trace_browse_ensure_init(void)
+{
+ static bool done = FALSE;
+ Word typeinfo_type;
+
+ if (! done) {
+ MR_TRACE_CALL_MERCURY(
+ ML_get_type_info_for_type_info(&typeinfo_type);
+ ML_BROWSE_browser_state_type(
+ &MR_trace_browser_state_type);
+ ML_BROWSE_init_state(&MR_trace_browser_state);
+ );
+
+ MR_trace_browser_state_type = MR_make_permanent(
+ MR_trace_browser_state_type,
+ (Word *) typeinfo_type);
+ MR_trace_browser_state = MR_make_permanent(
+ MR_trace_browser_state,
+ (Word *) MR_trace_browser_state_type);
+ done = TRUE;
+ }
+}
Index: trace/mercury_trace_browse.h
===================================================================
RCS file: mercury_trace_browse.h
diff -N mercury_trace_browse.h
--- /dev/null Mon Nov 16 03:45:03 1998
+++ mercury_trace_browse.h Mon Nov 16 02:47:26 1998
@@ -0,0 +1,26 @@
+/*
+** Copyright (C) 1998 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.
+*/
+
+/*
+** mercury_trace_browse.h
+**
+** Defines the interface of the term browser for the internal debugger.
+*/
+
+#ifndef MERCURY_TRACE_BROWSE_H
+#define MERCURY_TRACE_BROWSE_H
+
+/*
+** Interactively browse a term.
+*/
+extern void MR_trace_browse(Word type_info, Word value);
+
+/*
+** Display a term (non-interactively).
+*/
+extern void MR_trace_print(Word type_info, Word value);
+
+#endif /* MERCURY_TRACE_BROWSE_H */
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.15
diff -u -r1.15 mercury_trace_internal.c
--- mercury_trace_internal.c 1998/11/15 14:00:34 1.15
+++ mercury_trace_internal.c 1998/11/15 15:54:43
@@ -15,6 +15,7 @@
#include "mercury_trace_internal.h"
#include "mercury_trace_alias.h"
#include "mercury_trace_help.h"
+#include "mercury_trace_browse.h"
#include "mercury_trace_spy.h"
#include "mercury_trace_tables.h"
#include "mercury_trace_util.h"
@@ -1756,15 +1757,10 @@
/*
** XXX The printing of type_infos is buggy at the moment
** due to the fake arity of the type private_builtin:typeinfo/1.
- **
- ** XXX The printing of large data structures is painful
- ** at the moment due to the lack of a true browser.
*/
if ((strncmp(name, "TypeInfo", 8) == 0)
- || (strncmp(name, "TypeClassInfo", 13) == 0)
- || (strncmp(name, "ModuleInfo", 10) == 0)
- || (strncmp(name, "HLDS", 4) == 0))
+ || (strncmp(name, "TypeClassInfo", 13) == 0))
return;
/* The initial blanks are to visually separate */
@@ -1791,20 +1787,13 @@
base_sp, base_curfr, type_params, &type_info, &value);
if (print_value) {
if (browse) {
- MR_TRACE_CALL_MERCURY(
- ML_browse(type_info, value);
- );
+ MR_trace_browse(type_info, value);
} else {
printf("\t");
fflush(stdout);
- MR_TRACE_CALL_MERCURY(
- MR_write_variable(type_info, value);
- );
+ MR_trace_print(type_info, value);
}
}
-
- /* XXX if browse? */
- printf("\n");
}
static const char *
--
Fergus Henderson <fjh at cs.mu.oz.au> | "Binaries may die
WWW: <http://www.cs.mu.oz.au/~fjh> | but source code lives forever"
PGP: finger fjh at 128.250.37.3 | -- leaked Microsoft memo.
More information about the developers
mailing list