This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/Logtalk/library/event_dbg.lgt
pmoura 6b4bde14e1 Logtalk 2.30.1 files.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1903 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2007-06-12 10:39:47 +00:00

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.