| 1 | |
|---|
| 2 | :- object(event_dbg, |
|---|
| 3 | implements(event_dbgp, monitoring), |
|---|
| 4 | imports(monitor)). |
|---|
| 5 | |
|---|
| 6 | :- info([ |
|---|
| 7 | version is 1.1, |
|---|
| 8 | date is 2006/12/15, |
|---|
| 9 | author is 'Paulo Moura', |
|---|
| 10 | comment is 'Debugging facilities similar to those found in most Prolog compilers.']). |
|---|
| 11 | |
|---|
| 12 | :- initialization(::init). |
|---|
| 13 | |
|---|
| 14 | :- protected(port_output/4). |
|---|
| 15 | :- mode(port_output(+atom, +object, @callable, +object), one). |
|---|
| 16 | :- info(port_output/4, [ |
|---|
| 17 | comment is 'Outputs current port information.', |
|---|
| 18 | argnames is ['Port', 'Object', 'Message', 'Sender']]). |
|---|
| 19 | |
|---|
| 20 | :- protected(execute_option/1). |
|---|
| 21 | :- mode(execute_option(+atom), one). |
|---|
| 22 | :- info(execute_option/1, [ |
|---|
| 23 | comment is 'Executes a user option at a debugger port.', |
|---|
| 24 | argnames is ['Option']]). |
|---|
| 25 | |
|---|
| 26 | :- protected(query_user/1). |
|---|
| 27 | :- mode(query_user(-atom), one). |
|---|
| 28 | :- info(query_user/1, [ |
|---|
| 29 | comment is 'Query a user about an option at a debugger port.', |
|---|
| 30 | argnames is ['Option']]). |
|---|
| 31 | |
|---|
| 32 | :- private(stream_/2). |
|---|
| 33 | :- dynamic(stream_/2). |
|---|
| 34 | :- mode(stream_(?atom, ?stream), zero_or_more). |
|---|
| 35 | :- info(stream/2, [ |
|---|
| 36 | comment is 'Stores the current debugger input and ouput streams.', |
|---|
| 37 | argnames is ['Kind', 'Stream']]). |
|---|
| 38 | |
|---|
| 39 | stream(Name, Stream) :- |
|---|
| 40 | ::stream_(Name, Stream). |
|---|
| 41 | |
|---|
| 42 | set_stream(Name, Stream) :- |
|---|
| 43 | ::retractall(stream_(Name, _)), |
|---|
| 44 | ::assertz(stream_(Name, Stream)). |
|---|
| 45 | |
|---|
| 46 | trace :- |
|---|
| 47 | self(Self), |
|---|
| 48 | abolish_events(before, _, _, _, Self), |
|---|
| 49 | abolish_events(after, _, _, _, Self), |
|---|
| 50 | define_events(before, _, _, _, Self), |
|---|
| 51 | define_events(after, _, _, _, Self). |
|---|
| 52 | |
|---|
| 53 | notrace :- |
|---|
| 54 | self(Self), |
|---|
| 55 | abolish_events(before, _, _, _, Self), |
|---|
| 56 | abolish_events(after, _, _, _, Self). |
|---|
| 57 | |
|---|
| 58 | debugging :- |
|---|
| 59 | ::monitor_activated. |
|---|
| 60 | |
|---|
| 61 | debug :- |
|---|
| 62 | ::activate_monitor. |
|---|
| 63 | |
|---|
| 64 | nodebug :- |
|---|
| 65 | ::suspend_monitor. |
|---|
| 66 | |
|---|
| 67 | port_output(Port, Object, Message, Sender) :- |
|---|
| 68 | ::stream(output, Output), |
|---|
| 69 | write(Output, Port), |
|---|
| 70 | write(Output, ': '), |
|---|
| 71 | writeq(Output, Object), |
|---|
| 72 | write(Output, ' <- '), |
|---|
| 73 | writeq(Output, Message), |
|---|
| 74 | write(Output, ' from '), |
|---|
| 75 | writeq(Output, Sender), |
|---|
| 76 | nl(Output). |
|---|
| 77 | |
|---|
| 78 | query_user(Option) :- |
|---|
| 79 | ::stream(output, Output), |
|---|
| 80 | ::stream(input, Input), |
|---|
| 81 | repeat, |
|---|
| 82 | write(Output, ' >> '), |
|---|
| 83 | read(Input, Option), |
|---|
| 84 | nl(Output), |
|---|
| 85 | ( valid_option(Option) -> |
|---|
| 86 | true |
|---|
| 87 | ; ::execute_option(h), |
|---|
| 88 | fail |
|---|
| 89 | ), |
|---|
| 90 | !. |
|---|
| 91 | |
|---|
| 92 | execute_option(c). |
|---|
| 93 | execute_option(f) :- |
|---|
| 94 | !, fail. |
|---|
| 95 | execute_option(n) :- |
|---|
| 96 | ::nodebug. |
|---|
| 97 | execute_option(b) :- |
|---|
| 98 | ::stream(output,Output), |
|---|
| 99 | ::stream(input, Input), |
|---|
| 100 | repeat, |
|---|
| 101 | write(Output, ' :- '), |
|---|
| 102 | read(Input, Goal), |
|---|
| 103 | writeq(Output, Goal), |
|---|
| 104 | nl(Output), |
|---|
| 105 | ( once(Goal) -> |
|---|
| 106 | write(Output, ' answer: '), |
|---|
| 107 | writeq(Output, Goal), nl(Output) |
|---|
| 108 | ; write(Output, ' no'), nl(Output) |
|---|
| 109 | ), |
|---|
| 110 | Goal = true, |
|---|
| 111 | !. |
|---|
| 112 | execute_option(a) :- |
|---|
| 113 | throw(error(logtalk_execution_aborted)). |
|---|
| 114 | execute_option(h) :- |
|---|
| 115 | ::stream(output, Output), |
|---|
| 116 | write(Output, ' Available options are:'), nl(Output), |
|---|
| 117 | write(Output, ' c - creep (go on)'), nl(Output), |
|---|
| 118 | write(Output, ' f - fail (force failure or backtracking)'), nl(Output), |
|---|
| 119 | write(Output, ' n - nodebug (turn off debug)'), nl(Output), |
|---|
| 120 | write(Output, ' b - break (submit queries to the interpreter, type true to terminate)'), nl(Output), |
|---|
| 121 | write(Output, ' a - abort (return to top level interpreter)'), nl(Output), |
|---|
| 122 | write(Output, ' h - help (prints this list of options)'), nl(Output), |
|---|
| 123 | nl(Output). |
|---|
| 124 | |
|---|
| 125 | valid_option(c). |
|---|
| 126 | valid_option(f). |
|---|
| 127 | valid_option(n). |
|---|
| 128 | valid_option(b). |
|---|
| 129 | valid_option(a). |
|---|
| 130 | |
|---|
| 131 | before(Object, Message, Sender) :- |
|---|
| 132 | ::port_output(call, Object, Message, Sender), |
|---|
| 133 | ::query_user(Option), |
|---|
| 134 | ::execute_option(Option). |
|---|
| 135 | |
|---|
| 136 | after(Object, Message, Sender) :- |
|---|
| 137 | ::port_output(exit, Object, Message, Sender), |
|---|
| 138 | ::query_user(Option), |
|---|
| 139 | ::execute_option(Option). |
|---|
| 140 | |
|---|
| 141 | init :- |
|---|
| 142 | ::reset_monitor, |
|---|
| 143 | current_input(Input), |
|---|
| 144 | ::set_stream(input, Input), |
|---|
| 145 | current_output(Output), |
|---|
| 146 | ::set_stream(output, Output). |
|---|
| 147 | |
|---|
| 148 | :- end_object. |
|---|
