34
35:- module(prolog_debug_tools,
36 [ (spy)/1, 37 (nospy)/1, 38 nospyall/0,
39 debugging/0,
40 trap/1, 41 notrap/1 42 ]). 43:- use_module(library(broadcast), [broadcast/1]). 44:- autoload(library(edinburgh), [debug/0]). 45:- autoload(library(gensym), [gensym/2]). 46
54
60
61:- multifile
62 prolog:debug_control_hook/1. 63
64:- meta_predicate
65 spy(:),
66 nospy(:). 67
82
83spy(_:X) :-
84 var(X),
85 throw(error(instantiation_error, _)).
86spy(_:[]) :- !.
87spy(M:[H|T]) :-
88 !,
89 spy(M:H),
90 spy(M:T).
91spy(Spec) :-
92 notrace(prolog:debug_control_hook(spy(Spec))),
93 !.
94spy(Spec) :-
95 '$find_predicate'(Spec, Preds),
96 '$member'(PI, Preds),
97 pi_to_head(PI, Head),
98 '$define_predicate'(Head),
99 '$spy'(Head),
100 fail.
101spy(_).
102
103nospy(_:X) :-
104 var(X),
105 throw(error(instantiation_error, _)).
106nospy(_:[]) :- !.
107nospy(M:[H|T]) :-
108 !,
109 nospy(M:H),
110 nospy(M:T).
111nospy(Spec) :-
112 notrace(prolog:debug_control_hook(nospy(Spec))),
113 !.
114nospy(Spec) :-
115 '$find_predicate'(Spec, Preds),
116 '$member'(PI, Preds),
117 pi_to_head(PI, Head),
118 '$nospy'(Head),
119 fail.
120nospy(_).
121
122nospyall :-
123 notrace(prolog:debug_control_hook(nospyall)),
124 fail.
125nospyall :-
126 spy_point(Head),
127 '$nospy'(Head),
128 fail.
129nospyall.
130
131pi_to_head(M:PI, M:Head) :-
132 !,
133 pi_to_head(PI, Head).
134pi_to_head(Name/Arity, Head) :-
135 functor(Head, Name, Arity).
136
140
141debugging :-
142 notrace(prolog:debug_control_hook(debugging)),
143 !.
144debugging :-
145 ( current_prolog_flag(debug, true)
146 -> print_message(informational, debugging(on)),
147 findall(H, spy_point(H), SpyPoints),
148 print_message(informational, spying(SpyPoints))
149 ; print_message(informational, debugging(off))
150 ),
151 trapping.
152
153spy_point(Module:Head) :-
154 current_predicate(_, Module:Head),
155 '$get_predicate_attribute'(Module:Head, spy, 1),
156 \+ predicate_property(Module:Head, imported_from(_)).
157
158
159 162
178
179:- dynamic
180 exception/4, 181 installed/1. 182
183trap(Error) :-
184 gensym(ex, Rule),
185 asserta(exception(Rule, error(Error, _), true, true)),
186 print_message(informational, trap(Rule, error(Error, _), true, true)),
187 install_exception_hook,
188 debug.
189
190notrap(Error) :-
191 Exception = error(Error, _),
192 findall(exception(Name, Exception, NotCaught, Caught),
193 retract(exception(Name, error(Error, _), Caught, NotCaught)),
194 Trapping),
195 print_message(informational, notrap(Trapping)).
196
197
198trapping :-
199 findall(exception(Name, Term, NotCaught, Caught),
200 exception(Name, Term, NotCaught, Caught),
201 Trapping),
202 print_message(information, trapping(Trapping)).
203
204:- dynamic
205 user:prolog_exception_hook/4. 206
210
211:- public exception_hook/4. 212
213exception_hook(Ex, Ex, _Frame, Catcher) :-
214 thread_self(Me),
215 thread_property(Me, debug(true)),
216 broadcast(debug(exception(Ex))),
217 exception(_, Ex, NotCaught, Caught),
218 !,
219 ( Caught == true
220 -> true
221 ; Catcher == none,
222 NotCaught == true
223 ),
224 trace, fail.
225
226
230
231install_exception_hook :-
232 installed(Ref),
233 ( nth_clause(_, I, Ref)
234 -> I == 1, ! 235 ; retractall(installed(Ref)),
236 erase(Ref), 237 fail
238 ).
239install_exception_hook :-
240 asserta((user:prolog_exception_hook(Ex, Out, Frame, Catcher) :-
241 exception_hook(Ex, Out, Frame, Catcher)), Ref),
242 assert(installed(Ref)).
243
244
245 248
249:- multifile
250 prolog:message//1. 251
252prolog:message(trapping([])) -->
253 [ 'No exception traps'-[] ].
254prolog:message(trapping(Trapping)) -->
255 [ 'Exception traps on'-[], nl ],
256 trapping(Trapping).
257prolog:message(trap(_Rule, Error, _Caught, _NotCaught)) -->
258 [ 'Installed trap for exception '-[] ],
259 exception(Error),
260 [ nl ].
261prolog:message(notrap([])) -->
262 [ 'No matching traps'-[] ].
263prolog:message(notrap(Trapping)) -->
264 [ 'Removed traps from exceptions'-[], nl ],
265 trapping(Trapping).
266
267trapping([]) --> [].
268trapping([exception(_Rule, Error, _Caught, _NotCaught)|T]) -->
269 [ ' '-[] ],
270 exception(Error),
271 [ nl ],
272 trapping(T).
273
274exception(Term) -->
275 { copy_term(Term, T2),
276 numbervars(T2, 0, _, [singletons(true)])
277 },
278 [ '~p'-[T2] ]