6b4bde14e1
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1903 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
149 lines
3.7 KiB
Plaintext
149 lines
3.7 KiB
Plaintext
|
|
:- object(event_dbg,
|
|
implements(event_dbgp, monitoring),
|
|
imports(monitor)).
|
|
|
|
:- info([
|
|
version is 1.1,
|
|
date is 2006/12/15,
|
|
author is 'Paulo Moura',
|
|
comment is 'Debugging facilities similar to those found in most Prolog compilers.']).
|
|
|
|
:- initialization(::init).
|
|
|
|
:- protected(port_output/4).
|
|
:- mode(port_output(+atom, +object, @callable, +object), one).
|
|
:- info(port_output/4, [
|
|
comment is 'Outputs current port information.',
|
|
argnames is ['Port', 'Object', 'Message', 'Sender']]).
|
|
|
|
:- protected(execute_option/1).
|
|
:- mode(execute_option(+atom), one).
|
|
:- info(execute_option/1, [
|
|
comment is 'Executes a user option at a debugger port.',
|
|
argnames is ['Option']]).
|
|
|
|
:- protected(query_user/1).
|
|
:- mode(query_user(-atom), one).
|
|
:- info(query_user/1, [
|
|
comment is 'Query a user about an option at a debugger port.',
|
|
argnames is ['Option']]).
|
|
|
|
:- private(stream_/2).
|
|
:- dynamic(stream_/2).
|
|
:- mode(stream_(?atom, ?stream), zero_or_more).
|
|
:- info(stream/2, [
|
|
comment is 'Stores the current debugger input and ouput streams.',
|
|
argnames is ['Kind', 'Stream']]).
|
|
|
|
stream(Name, Stream) :-
|
|
::stream_(Name, Stream).
|
|
|
|
set_stream(Name, Stream) :-
|
|
::retractall(stream_(Name, _)),
|
|
::assertz(stream_(Name, Stream)).
|
|
|
|
trace :-
|
|
self(Self),
|
|
abolish_events(before, _, _, _, Self),
|
|
abolish_events(after, _, _, _, Self),
|
|
define_events(before, _, _, _, Self),
|
|
define_events(after, _, _, _, Self).
|
|
|
|
notrace :-
|
|
self(Self),
|
|
abolish_events(before, _, _, _, Self),
|
|
abolish_events(after, _, _, _, Self).
|
|
|
|
debugging :-
|
|
::monitor_activated.
|
|
|
|
debug :-
|
|
::activate_monitor.
|
|
|
|
nodebug :-
|
|
::suspend_monitor.
|
|
|
|
port_output(Port, Object, Message, Sender) :-
|
|
::stream(output, Output),
|
|
write(Output, Port),
|
|
write(Output, ': '),
|
|
writeq(Output, Object),
|
|
write(Output, ' <- '),
|
|
writeq(Output, Message),
|
|
write(Output, ' from '),
|
|
writeq(Output, Sender),
|
|
nl(Output).
|
|
|
|
query_user(Option) :-
|
|
::stream(output, Output),
|
|
::stream(input, Input),
|
|
repeat,
|
|
write(Output, ' >> '),
|
|
read(Input, Option),
|
|
nl(Output),
|
|
( valid_option(Option) ->
|
|
true
|
|
; ::execute_option(h),
|
|
fail
|
|
),
|
|
!.
|
|
|
|
execute_option(c).
|
|
execute_option(f) :-
|
|
!, fail.
|
|
execute_option(n) :-
|
|
::nodebug.
|
|
execute_option(b) :-
|
|
::stream(output,Output),
|
|
::stream(input, Input),
|
|
repeat,
|
|
write(Output, ' :- '),
|
|
read(Input, Goal),
|
|
writeq(Output, Goal),
|
|
nl(Output),
|
|
( once(Goal) ->
|
|
write(Output, ' answer: '),
|
|
writeq(Output, Goal), nl(Output)
|
|
; write(Output, ' no'), nl(Output)
|
|
),
|
|
Goal = true,
|
|
!.
|
|
execute_option(a) :-
|
|
throw(error(logtalk_execution_aborted)).
|
|
execute_option(h) :-
|
|
::stream(output, Output),
|
|
write(Output, ' Available options are:'), nl(Output),
|
|
write(Output, ' c - creep (go on)'), nl(Output),
|
|
write(Output, ' f - fail (force failure or backtracking)'), nl(Output),
|
|
write(Output, ' n - nodebug (turn off debug)'), nl(Output),
|
|
write(Output, ' b - break (submit queries to the interpreter, type true to terminate)'), nl(Output),
|
|
write(Output, ' a - abort (return to top level interpreter)'), nl(Output),
|
|
write(Output, ' h - help (prints this list of options)'), nl(Output),
|
|
nl(Output).
|
|
|
|
valid_option(c).
|
|
valid_option(f).
|
|
valid_option(n).
|
|
valid_option(b).
|
|
valid_option(a).
|
|
|
|
before(Object, Message, Sender) :-
|
|
::port_output(call, Object, Message, Sender),
|
|
::query_user(Option),
|
|
::execute_option(Option).
|
|
|
|
after(Object, Message, Sender) :-
|
|
::port_output(exit, Object, Message, Sender),
|
|
::query_user(Option),
|
|
::execute_option(Option).
|
|
|
|
init :-
|
|
::reset_monitor,
|
|
current_input(Input),
|
|
::set_stream(input, Input),
|
|
current_output(Output),
|
|
::set_stream(output, Output).
|
|
|
|
:- end_object.
|