root/tags/lgt2212/library/event_dbg.lgt

:- object(event_dbg,
    implements(event_dbgp, event_handlersp),
    imports(monitor)).


    :- info([
        version is 1.0,
        date is 2000/7/24,
        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.