1/* Part of LogicMOO Base Logicmoo Debug Tools 2% =================================================================== 3% File '$FILENAME.pl' 4% Purpose: An Implementation in SWI-Prolog of certain debugging tools 5% Maintainer: Douglas Miles 6% Contact: $Author: dmiles $@users.sourceforge.net ; 7% Version: '$FILENAME.pl' 1.0.0 8% Revision: $Revision: 1.1 $ 9% Revised At: $Date: 2002/07/11 21:57:28 $ 10% Licience: LGPL 11% =================================================================== 12*/ 13:- module(rtrace, 14 [ 15 rtrace/1, % Non-interactive tracing 16 rtrace_break/1, % Interactive tracing 17 quietly/1, % Non-det notrace/1 18 restore_trace/1, % After call restor tracer 19 rtrace/0, % Start non-intractive tracing 20 srtrace/0, % Start non-intractive tracing at System level 21 nortrace/0, % Stop non-intractive tracing 22 push_tracer/0,pop_tracer/0,reset_tracer/0, % Reset Tracer to "normal" 23 on_x_debug/1, % Non-intractive tracing when exception occurs 24 on_f_rtrace/1, % Non-intractive tracing when failure occurs 25 maybe_leash/1, % Set leash only when it makes sense 26 maybe_leash/0, 27 non_user_console/0, 28 ftrace/1, % rtrace showing only failures 29 push_guitracer/0,pop_guitracer/0 30 ]). 31 32:- set_module(class(library)). 33:- module_transparent(nortrace/0). 34:- use_module(library(logicmoo_util_startup)). 35 36:-thread_local(t_l:rtracing/0). 37:-thread_local(t_l:tracer_reset/1). 38:-thread_local(t_l:wasguitracer/1). 39:-thread_local(t_l:wastracer/1). 40 41:- 'meta_predicate'(call_call()). 42call_call(G):-call(G). 43 44 45:- meta_predicate 46 rtrace(), 47 restore_trace(), 48 on_x_debug(), 49 on_f_rtrace(), 50 51 rtrace_break(), 52 quietly(), 53 ftrace().
61% on_f_rtrace(Goal):- Goal *-> true; ((nortrace,notrace,debugCallWhy(failed(on_f_rtrace(Goal)),Goal)),fail). 62 63on_f_rtrace(Goal):- *-> true; (rtrace(Goal),debugCallWhy(on_f_rtrace(Goal),Goal)).
71on_x_debug(Goal):- 72 ((( tracing; t_l:rtracing),maybe_leash(+exception))) 73 -> 74 ; 75 (catchv(Goal,E,(ignore(debugCallWhy(on_x_debug(E,Goal),Goal)),throw(E)))). 76 77 78:- meta_predicate('$with_unlocked_pred_local'(,)). 79'$with_unlocked_pred_local'(MP,Goal):- strip_module(MP,M,P),Pred=M:P, 80 (predicate_property(Pred,foreign)-> true ; 81 ( 82 ('$get_predicate_attribute'(Pred, system, OnOff)->true;throw('$get_predicate_attribute'(Pred, system, OnOff))), 83 (==(OnOff,0) -> ; 84 setup_call_cleanup('$set_predicate_attribute'(Pred, system, 0), 85 catch(Goal,E,throw(E)),'$set_predicate_attribute'(Pred, system, 1))))). 86 87:- meta_predicate(totally_hide()). 88totally_hide(MP):- strip_module(MP,M,P),Pred=M:P, 89 % (current_prolog_flag(runtime_debug,N), N>2) -> unhide(Pred) ; 90 '$with_unlocked_pred_local'(Pred, 91 (('$set_predicate_attribute'(Pred, trace, false),'$set_predicate_attribute'(Pred, hide_childs, true)))). 92 93unhide(Pred):- '$set_predicate_attribute'(Pred, trace, true),mpred_trace_childs(Pred).
99maybe_leash(Some):- notrace((maybe_leash->leash(Some);true)). 100:- totally_hide(maybe_leash/1). 101 102maybe_leash:- notrace((\+ current_prolog_flag(runtime_must,keep_going), \+ non_user_console)). 103 104non_user_console:- !,fail. 105non_user_console:- \+ stream_property(current_input, tty(true)),!. 106non_user_console:- \+ stream_property(current_input,close_on_abort(false)).
112get_trace_reset((notrace,set_prolog_flag(debug,WasDebug),CC3,'$visible'(_, OldV),'$leash'(_, OldL),RestoreTrace)):- 113 (notrace(tracing) -> (notrace,RestoreTrace = trace) ; RestoreTrace = notrace), 114 '$leash'(OldL, OldL),'$visible'(OldV, OldV), 115 (current_prolog_flag(debug,true)->WasDebug=true;WasDebug=false), 116 (current_prolog_flag(gui_tracer, GWas)->CC3=set_prolog_flag(gui_tracer, GWas);CC3=true),!, 117 . 118 119:- totally_hide(get_trace_reset/1). 120:- totally_hide(get_trace_reset/1).
128push_guitracer:- notrace(ignore(((current_prolog_flag(gui_tracer, GWas);GWas=false),asserta(t_l:wasguitracer(GWas))))). 129:- totally_hide(push_guitracer/0).
136pop_guitracer:- notrace(ignore(((retract(t_l:wasguitracer(GWas)),set_prolog_flag(gui_tracer, GWas))))). 137:- totally_hide(pop_guitracer/0).
144push_tracer:- get_trace_reset(Reset)->asserta(t_l:tracer_reset(Reset)). 145:- totally_hide(push_tracer/0).
151pop_tracer:- notrace((retract(t_l:tracer_reset(Reset))->Reset;true)). 152:- totally_hide(pop_tracer/0).
158reset_tracer:- ignore((t_l:tracer_reset(Reset)->Reset;true)). 159:- totally_hide(reset_tracer/0). 160 161 162:- multifile(user:prolog_exception_hook/4). 163:- dynamic(user:prolog_exception_hook/4). 164:- module_transparent(user:prolog_exception_hook/4). 165 166% Make sure interactive debugging is turned back on 167 168userprolog_exception_hook(error(_, _),_, _, _) :- leash(+all),fail. 169 170userprolog_exception_hook(error(_, _),_, _, _) :- fail, 171 notrace(( reset_tracer -> 172 maybe_leash -> 173 t_l:rtracing -> 174 leash(+all), 175 fail)).
But also may be break when excpetions are raised during Goal.
184% Version 1 185quietly(Goal):- \+ tracing,!,call(Goal). 186quietly(Goal):- notrace,call_cleanup(Goal,trace). 187 188% version 2 189quietly2(Goal):- \+ tracing -> ; (notrace,call_cleanup(scce_orig(notrace,Goal,trace),trace)). 190 191% version 3 192% quietly(Goal):- !, Goal. % for overiding 193quietly3(Goal):- \+ tracing -> ; 194 (notrace, 195 (((,deterministic(YN))) *-> 196 (YN == yes -> trace ; (trace;(notrace,fail))); 197 (trace,!,notrace(fail)))). 198 199 200 201deterministically_must(G):- call(call,G),deterministic(YN),true, 202 (YN==true -> true; 203 ((wdmsg(failed_deterministically_must(G)),(!)))),!. 204 205 206%:- totally_hide(quietly/1).
214rtrace:- start_rtrace,trace. 215 216:- 'totally_hide'(rtrace/0). 217 218start_rtrace:- 219 leash(-all), 220 assert(t_l:rtracing), 221 set_prolog_flag(access_level,system), 222 push_guitracer, 223 set_prolog_flag(gui_tracer,false), 224 visible(+all), 225 visible(+exception), 226 maybe_leash(+exception). 227 228:- 'totally_hide'(start_rtrace/0).
234srtrace:- notrace, set_prolog_flag(access_level,system), rtrace. 235 236:- totally_hide(srtrace/0).
244stop_rtrace:- 245 notrace, 246 maybe_leash(+all), 247 visible(+all), 248 maybe_leash(+exception), 249 retractall(t_l:rtracing), 250 !. 251 252:- 'totally_hide'(stop_rtrace/0). 253:- system:import(stop_rtrace/0). 254 255nortrace:- stop_rtrace,ignore(pop_tracer). 256 257:- totally_hide(nortrace/0). 258 259 260:- thread_local('$leash_visible'/2).
! restore_trace( :Goal) is nondet.
restore Trace.
270restore_trace(Goal):- 271 setup_call_cleanup( 272 push_leash_visible, 273 scce_orig(push_tracer,Goal,pop_tracer), 274 restore_leash_visible). 275 276restore_trace0(Goal):- 277 '$leash'(OldL, OldL),'$visible'(OldV, OldV), 278 scce_orig(restore_leash_visible, 279 ((Goal*-> (push_leash_visible, '$leash'(_, OldL),'$visible'(_, OldV)) ; fail)), 280 ('$leash'(_, OldL),'$visible'(_, OldV))). 281 282:- totally_hide(system:'$leash'/2). 283:- totally_hide(system:'$visible'/2). 284 285push_leash_visible:- notrace((('$leash'(OldL0, OldL0),'$visible'(OldV0, OldV0), asserta('$leash_visible'(OldL0,OldV0))))). 286restore_leash_visible:- notrace((('$leash_visible'(OldL1,OldV1)->('$leash'(_, OldL1),'$visible'(_, OldV1));true))). 287 288% restore_trace(Goal):- setup_call_cleanup(get_trace_reset(Reset),Goal,notrace(Reset)). 289:- totally_hide(restore_trace/0).
?- rtrace(member(X,[1,2,3])). Call: (9) [lists] lists:member(_7172, [1, 2, 3]) Unify: (9) [lists] lists:member(_7172, [1, 2, 3]) Call: (10) [lists] lists:member_([2, 3], _7172, 1) Unify: (10) [lists] lists:member_([2, 3], 1, 1) Exit: (10) [lists] lists:member_([2, 3], 1, 1) Exit: (9) [lists] lists:member(1, [1, 2, 3]) X = 1 ; Redo: (10) [lists] lists:member_([2, 3], _7172, 1) Unify: (10) [lists] lists:member_([2, 3], _7172, 1) Call: (11) [lists] lists:member_([3], _7172, 2) Unify: (11) [lists] lists:member_([3], 2, 2) Exit: (11) [lists] lists:member_([3], 2, 2) Exit: (10) [lists] lists:member_([2, 3], 2, 1) Exit: (9) [lists] lists:member(2, [1, 2, 3]) X = 2 ; Redo: (11) [lists] lists:member_([3], _7172, 2) Unify: (11) [lists] lists:member_([3], _7172, 2) Call: (12) [lists] lists:member_([], _7172, 3) Unify: (12) [lists] lists:member_([], 3, 3) Exit: (12) [lists] lists:member_([], 3, 3) Exit: (11) [lists] lists:member_([3], 3, 2) Exit: (10) [lists] lists:member_([2, 3], 3, 1) Exit: (9) [lists] lists:member(3, [1, 2, 3]) X = 3.
?- rtrace(fail).
Call: (9) [system] fail
Fail: (9) [system] fail
^ Redo: (8) [rtrace] rtrace:rtrace(user:fail)
false.
330/* 331 ?- rtrace((member(X,[writeln(1),throw(good),writen(failed)]),X)). 332 Call: (10) [lists] lists:member(_13424, [writeln(1), throw(good), writen(failed)]) 333 Unify: (10) [lists] lists:member(_13424, [writeln(1), throw(good), writen(failed)]) 334 Call: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1)) 335 Unify: (11) [lists] lists:member_([throw(good), writen(failed)], writeln(1), writeln(1)) 336 Exit: (11) [lists] lists:member_([throw(good), writen(failed)], writeln(1), writeln(1)) 337 Exit: (10) [lists] lists:member(writeln(1), [writeln(1), throw(good), writen(failed)]) 338 Call: (10) [system] writeln(1) 3391 340 Exit: (10) [system] writeln(1) 341X = writeln(1) ; 342 Redo: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1)) 343 Unify: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1)) 344 Call: (12) [lists] lists:member_([writen(failed)], _13424, throw(good)) 345 Unify: (12) [lists] lists:member_([writen(failed)], throw(good), throw(good)) 346 Exit: (12) [lists] lists:member_([writen(failed)], throw(good), throw(good)) 347 Exit: (11) [lists] lists:member_([throw(good), writen(failed)], throw(good), writeln(1)) 348 Exit: (10) [lists] lists:member(throw(good), [writeln(1), throw(good), writen(failed)]) 349 Call: (10) [system] throw(good) 350ERROR: Unhandled exception: good 351*/ 352 353set_leash_vis(OldL,OldV):- '$leash'(_, OldL),'$visible'(_, OldV),!. 354:- totally_hide(set_leash_vis/2). 355 356next_rtrace:- (nortrace;(rtrace,trace,notrace(fail))). 357:- 'totally_hide'(next_rtrace/0). 358 359 360rtrace(Goal):- notrace(tracing)-> rtrace0((trace,Goal)) ; 361 setup_call_cleanup(current_prolog_flag(debug,WasDebug), 362 rtrace0((trace,Goal)),(set_prolog_flag(debug,WasDebug),notrace(stop_rtrace))). 363rtrace0(Goal):- 364 setup_call_cleanup(notrace((current_prolog_flag(debug,O),rtrace)), 365 (trace,Goal,notrace,deterministic(YN), 366 (YN == true->!;next_rtrace)), 367 notrace(set_prolog_flag(debug,O))). 368 369:- '$hide'(rtrace/1). 370:- '$hide'(rtrace0/1). 371:- '$set_predicate_attribute'(rtrace/1, hide_childs, true). 372:- '$set_predicate_attribute'(rtrace0/1, hide_childs, false).
380rtrace_break(Goal):- \+ maybe_leash, !, rtrace(Goal). 381rtrace_break(Goal):- stop_rtrace,trace,debugCallWhy(rtrace_break(Goal),Goal). 382%:- totally_hide(rtrace_break/1). 383:- '$set_predicate_attribute'(rtrace_break/1, hide_childs, false). 384 385 386 387 388:- '$hide'(quietly/1). 389%:- if_may_hide('totally_hide'(notrace/1, hide_childs, 1)). 390%:- if_may_hide('totally_hide'(notrace/1)). 391:- totally_hide(system:tracing/0). 392:- totally_hide(system:notrace/0). 393:- totally_hide(system:notrace/1). 394:- totally_hide(system:trace/0).
400ftrace(Goal):- restore_trace(( 401 visible(-all),visible(+unify), 402 visible(+fail),visible(+exception), 403 maybe_leash(-all),maybe_leash(+exception),trace,Goal)). 404 405 406 407:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)), 408 forall(source_file(M:H,S), 409 ignore((functor(H,F,A), 410 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))), 411 ignore(((\+ predicate_property(M:H,transparent), module_transparent(M:F/A), \+ atom_concat('__aux',_,F),debug(modules,'~N:- module_transparent((~q)/~q).~n',[F,A]))))))))). 412 413:- use_module(library(logicmoo_util_common)). 414:- fixup_exports. 415:- totally_hide('$toplevel':save_debug). 416:- totally_hide('$toplevel':toplevel_call/1). 417:- totally_hide('$toplevel':residue_vars(_,_)). 418:- totally_hide('$toplevel':save_debug). 419:- totally_hide('$toplevel':no_lco).