1% ===================================================================
2% File 'poor_bugger.pl'
3% Purpose: a small number of debugging utils
4% The original debugging package that I created had too many interdependencies
5% Maintainer: Douglas Miles
6% Contact: $Author: dmiles $@users.sourceforge.net ;
7% Version: 'poor_bugger.pl' 1.0.0
8% Revision: $Revision: 1.1 $
9% Revised At: $Date: 2035/06/06 15:43:15 $
10% ===================================================================
17nop(_). 18 19update_deps :- 20 pack_install(each_call_cleanup,[url('https://github.com/TeamSPoon/each_call_cleanup.git'),upgrade(true),interactive(false)]), 21 pack_install(no_repeats,[url('https://github.com/TeamSPoon/no_repeats.git'),upgrade(true),interactive(false)]), 22 pack_install(loop_check,[url('https://github.com/TeamSPoon/loop_check.git'),upgrade(true),interactive(false)]), 23 % The whole point of me making Poor_bugger is to not need to install must_trace :) 24 nop(pack_install(must_trace,[url('https://github.com/TeamSPoon/must_trace.git'),upgrade(true),interactive(true)])), 25 % hoses developement 26 nop(pack_install(small_adventure_games,[url('https://github.com/TeamSPoon/small_adventure_games.git'),upgrade(true),interactive(true)])), 27 !. 28 29 30/* 31scce_orig(Setup,Goal,Cleanup):- 32 \+ \+ '$sig_atomic'(Setup), 33 catch( 34 ((Goal, deterministic(DET)), 35 '$sig_atomic'(Cleanup), 36 (DET == true -> ! 37 ; (true;('$sig_atomic'(Setup),fail)))), 38 E, 39 ('$sig_atomic'(Cleanup),throw(E))). 40 41:- abolish(system:scce_orig,3). 42 43 44[debug] ?- scce_orig( (writeln(a),trace,start_rtrace,rtrace) , (writeln(b),member(X,[1,2,3]),writeln(c)), writeln(d)). 45a 46b 47c 48d 49X = 1 ; 50a 51c 52d 53X = 2 ; 54a 55c 56d 57X = 3. 58 59 60*/ 61 62scce_orig(Setup0,Goal,Cleanup0):- 63 notrace((Cleanup = notrace('$sig_atomic'(Cleanup0)),Setup = notrace('$sig_atomic'(Setup0)))), 64 \+ \+ , !, 65 (catch(Goal, E,(Cleanup,throw(E))) 66 *-> (notrace(tracing)->(notrace,deterministic(DET));deterministic(DET)); (,!,fail)), 67 , 68 (DET == true -> ! ; (true;(,fail))). 69 70dbug(P):- notrace(ansi_format([fg(cyan)],'~N% ~p.~n',[P])). 71:- module_transparent(dmust/1). 72dmust((A,!,B)):-!,dmust(A),!,dmust(B). 73dmust((A,B)):-!,dmust(A),dmust(B). 74dmust((A;B)):-!,call(A),dmust(B). 75dmust((A->B;C)):-!,call(A)->dmust(B);dmust(C). 76dmust((A*->B;C)):-!,call(A)*->dmust(B);dmust(C). 77dmust(A):- call(A)*-> true ; failed_dmust(A). 78 79:- module_transparent(failed_dmust/1). 80failed_dmust(once(A)):-!, failed_dmust(A),!. 81failed_dmust((A,B)):- !,dbug(dmust_start(A)),ignore(rtrace(A)),dbug(dmust_mid(A)), failed_dmust(B). 82failed_dmust(A):- dbug(failed_dmust_start(A)),ignore(rtrace(A)),dbug(failed_dmust_end(A)), 83 break,nortrace,notrace,trace. 84 85:- if(\+ current_module(pfc)). 86:- module_transparent(call_u/1). 87call_u(Q):- notrace(current_predicate(_,Q)),call(call,Q). 88%call_u(P) :- call(call,P). 89:- endif. 90 91 92asserta_if_new(A):- clause(A,true)->true;asserta(A). 93atom_contains(Atom,SubAtom):- atomic_list_concat([_,_|_],SubAtom,Atom). 94 95 96no_repeats_must(Call):- 97 gripe_time(0.5,no_repeats(Call)) *-> true; 98 (fail,(dbug(warn(show_failure(Call))),!,fail)).
105call_for_time(Goal,ElapseCPU,ElapseWALL,Success):- 106 statistics(cputime,StartCPU0),statistics(walltime,[StartWALL0,_]), 107 My_Starts = start(StartCPU0,StartWALL0), 108 (*->Success=true;Success=fail), 109 statistics(cputime,EndCPU),statistics(walltime,[EndWALL,_]), 110 arg(1,My_Starts,StartCPU), ElapseCPU is EndCPU-StartCPU,nb_setarg(1,My_Starts,EndCPU), 111 arg(2,My_Starts,StartWALL), ElapseWALL is (EndWALL-StartWALL)/1000,nb_setarg(2,My_Starts,EndWALL). 112 113gripe_time(_TooLong,Goal):- current_prolog_flag(runtime_speed,0),!,. 114gripe_time(_TooLong,Goal):- current_prolog_flag(runtime_debug,0),!,. 115gripe_time(_TooLong,Goal):- current_prolog_flag(runtime_debug,1),!,. 116% gripe_time(_TooLong,Goal):- \+ current_prolog_flag(runtime_debug,3),\+ current_prolog_flag(runtime_debug,2),!,Goal. 117gripe_time(TooLong,Goal):- 118 call_for_time(Goal,ElapseCPU,ElapseWALL,Success), 119 (ElapseCPU>TooLong -> dbug(gripe_CPUTIME(Success,warn(ElapseCPU>TooLong),Goal)) ; 120 (ElapseWALL>TooLong -> dbug(gripe_WALLTIME(Success,warn(ElapseWALL>TooLong),Goal,cputime=ElapseCPU)) ; 121 true)), 122 . 123 124 125 126:- module_transparent(loop_check_u/1). 127loop_check_u(P):- loop_check(call_u(P)). 128 129% :- fixup_exports. 130 131%:- multifile(parser_sharing:term_expansion/4). 132%:- rtrace. 133/* 134parser_sharing:term_expansion(G,I,GG,O):- nonvar(I),compound(G),importing_clause(G,GG) -> G \== GG, I=O. 135:- export(parser_sharing:term_expansion/4). 136*/ 137%:- nortrace. 138 139:- module_transparent(nortrace/0). 140 141:-thread_local(t_l:rtracing/0). 142:-thread_local(t_l:tracer_reset/1). 143:-thread_local(t_l:wasguitracer/1). 144:-thread_local(t_l:wastracer/1). 145 146:- meta_predicate(call_call()). 147call_call(G):-call(G). 148 149 150:- meta_predicate 151 rtrace(), 152 restore_trace(), 153 on_x_debug(), 154 on_f_rtrace(), 155 rtrace_break(), 156 quietly(), 157 ftrace().
165% on_f_rtrace(Goal):- Goal *-> true; ((nortrace,notrace,debugCallWhy(failed(on_f_rtrace(Goal)),Goal)),fail). 166 167on_f_rtrace(Goal):- *-> true; (rtrace(Goal),debugCallWhy(on_f_rtrace(Goal),Goal)). 168 169 170 171debugCallWhy(Why, C):- dbug(Why),catch(failed_dmust(C),E,dbug(cont_X_debugCallWhy(E,Why, C))).
177on_x_debug(Goal):- 178 ((( tracing; t_l:rtracing),maybe_leash(+exception))) 179 -> 180 ; 181 (catch(Goal,E,(ignore(debugCallWhy(on_x_debug(E,Goal),Goal)),throw(E)))). 182 183 184:- meta_predicate('$with_unlocked_pred_local'(,)). 185'$with_unlocked_pred_local'(MP,Goal):- strip_module(MP,M,P),Pred=M:P, 186 (predicate_property(Pred,foreign)-> true ; 187 ( 188 ('$get_predicate_attribute'(Pred, system, OnOff)->true;throw('$get_predicate_attribute'(Pred, system, OnOff))), 189 (==(OnOff,0) -> ; 190 setup_call_cleanup('$set_predicate_attribute'(Pred, system, 0), 191 catch(Goal,E,throw(E)),'$set_predicate_attribute'(Pred, system, 1))))). 192 193:- meta_predicate(totally_hide()). 194totally_hide(MP):- strip_module(MP,M,P),Pred=M:P, 195 % (current_prolog_flag(runtime_debug,N), N>2) -> unhide(Pred) ; 196 '$with_unlocked_pred_local'(Pred, 197 (('$set_predicate_attribute'(Pred, trace, false),'$set_predicate_attribute'(Pred, hide_childs, true)))).
203with_unlocked_pred(MP,Goal):- strip_module(MP,M,P),Pred=M:P, 204 (predicate_property(Pred,foreign)-> true ; 205 ( 206 ('$get_predicate_attribute'(Pred, system, 0) -> ; 207 setup_call_cleanup('$set_predicate_attribute'(Pred, system, 0), 208 catch(Goal,E,throw(E)),'$set_predicate_attribute'(Pred, system, 1))))). 209 210unhide(Pred):- '$set_predicate_attribute'(Pred, trace, 1),'$set_predicate_attribute'(Pred, hide_childs, 0). 211 212 213/* 214mpred_trace_childs(W) :- forall(match_predicates(W,M,Pred,_,_),( 215 with_unlocked_pred(M:Pred,( 216 '$set_predicate_attribute'(M:Pred, trace, 0), 217 %'$set_predicate_attribute'(M:Pred, noprofile, 0), 218 '$set_predicate_attribute'(M:Pred, hide_childs, 0))))). 219*/
225maybe_leash(Some):- notrace((maybe_leash->leash(Some);true)). 226:- totally_hide(maybe_leash/1). 227 228maybe_leash:- notrace((\+ current_prolog_flag(runtime_must,keep_going), \+ non_user_console)). 229 230%non_user_console:- !,fail. 231non_user_console:- \+ stream_property(current_input, tty(true)),!. 232non_user_console:- \+ stream_property(current_input,close_on_abort(false)).
238get_trace_reset((notrace,set_prolog_flag(debug,WasDebug),CC3,'$visible'(_, OldV),'$leash'(_, OldL),RestoreTrace)):- 239 (notrace(tracing) -> (notrace,RestoreTrace = trace) ; RestoreTrace = notrace), 240 '$leash'(OldL, OldL),'$visible'(OldV, OldV), 241 (current_prolog_flag(debug,true)->WasDebug=true;WasDebug=false), 242 (current_prolog_flag(gui_tracer, GWas)->CC3=set_prolog_flag(gui_tracer, GWas);CC3=true),!, 243 . 244:- totally_hide(get_trace_reset/1).
251push_guitracer:- notrace(ignore(((current_prolog_flag(gui_tracer, GWas);GWas=false),asserta(t_l:wasguitracer(GWas))))). 252:- totally_hide(push_guitracer/0).
259pop_guitracer:- notrace(ignore(((retract(t_l:wasguitracer(GWas)),set_prolog_flag(gui_tracer, GWas))))). 260:- totally_hide(pop_guitracer/0).
267push_tracer:- get_trace_reset(Reset)->asserta(t_l:tracer_reset(Reset)). 268:- totally_hide(push_tracer/0).
274pop_tracer:- notrace((retract(t_l:tracer_reset(Reset))->Reset;true)). 275:- totally_hide(pop_tracer/0).
281reset_tracer:- ignore((t_l:tracer_reset(Reset)->Reset;true)). 282:- totally_hide(reset_tracer/0). 283 284 285:- multifile(user:prolog_exception_hook/4). 286:- dynamic(user:prolog_exception_hook/4). 287:- module_transparent(user:prolog_exception_hook/4). 288 289% Make sure interactive debugging is turned back on 290 291userprolog_exception_hook(error(_, _),_, _, _) :- leash(+all),fail. 292 293userprolog_exception_hook(error(_, _),_, _, _) :- fail, 294 notrace(( reset_tracer -> 295 maybe_leash -> 296 t_l:rtracing -> 297 leash(+all), 298 fail)).
But also may be break when excpetions are raised during Goal.
307% Version 1 308quietly(Goal):- \+ tracing,!,call(Goal). 309quietly(Goal):- notrace,call_cleanup(Goal,trace). 310 311% version 2 312quietly2(Goal):- \+ tracing -> ; (notrace,call_cleanup(scce_orig(notrace,Goal,trace),trace)). 313 314% version 3 315% quietly(Goal):- !, Goal. % for overiding 316quietly3(Goal):- \+ tracing -> ; 317 (notrace, 318 (((,deterministic(YN))) *-> 319 (YN == yes -> trace ; (trace;(notrace,fail))); 320 (trace,!,notrace(fail)))). 321 322 323 324deterministically_must(G):- call(call,G),deterministic(YN),true, 325 (YN==true -> true; 326 ((dbug(failed_deterministically_must(G)),(!)))),!. 327 328 329%:- totally_hide(quietly/1).
336rtrace:- start_rtrace,trace. 337 338:- totally_hide(rtrace/0). 339 340start_rtrace:- 341 leash(-all), 342 assert(t_l:rtracing), 343 set_prolog_flag(access_level,system), 344 push_guitracer, 345 set_prolog_flag(gui_tracer,false), 346 visible(+all), 347 visible(+exception), 348 maybe_leash(+exception). 349 350:- totally_hide(start_rtrace/0).
356srtrace:- notrace, set_prolog_flag(access_level,system), rtrace. 357 358:- totally_hide(srtrace/0).
366stop_rtrace:- 367 notrace, 368 maybe_leash(+all), 369 visible(+all), 370 maybe_leash(+exception), 371 retractall(t_l:rtracing), 372 !. 373 374:- totally_hide(stop_rtrace/0). 375:- system:import(stop_rtrace/0). 376 377nortrace:- stop_rtrace,ignore(pop_tracer). 378 379:- totally_hide(nortrace/0). 380 381 382:- thread_local('$leash_visible'/2).
! restore_trace( :Goal) is nondet.
restore Trace.
392restore_trace(Goal):- 393 setup_call_cleanup( 394 push_leash_visible, 395 scce_orig(push_tracer,Goal,pop_tracer), 396 restore_leash_visible). 397 398restore_trace0(Goal):- 399 '$leash'(OldL, OldL),'$visible'(OldV, OldV), 400 scce_orig(restore_leash_visible, 401 ((Goal*-> (push_leash_visible, '$leash'(_, OldL),'$visible'(_, OldV)) ; fail)), 402 ('$leash'(_, OldL),'$visible'(_, OldV))). 403 404:- totally_hide(system:'$leash'/2). 405:- totally_hide(system:'$visible'/2). 406 407push_leash_visible:- notrace((('$leash'(OldL0, OldL0),'$visible'(OldV0, OldV0), asserta('$leash_visible'(OldL0,OldV0))))). 408restore_leash_visible:- notrace((('$leash_visible'(OldL1,OldV1)->('$leash'(_, OldL1),'$visible'(_, OldV1));true))). 409 410% restore_trace(Goal):- setup_call_cleanup(get_trace_reset(Reset),Goal,notrace(Reset)). 411:- 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.
452/* 453 ?- rtrace((member(X,[writeln(1),throw(good),writen(failed)]),X)). 454 Call: (10) [lists] lists:member(_13424, [writeln(1), throw(good), writen(failed)]) 455 Unify: (10) [lists] lists:member(_13424, [writeln(1), throw(good), writen(failed)]) 456 Call: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1)) 457 Unify: (11) [lists] lists:member_([throw(good), writen(failed)], writeln(1), writeln(1)) 458 Exit: (11) [lists] lists:member_([throw(good), writen(failed)], writeln(1), writeln(1)) 459 Exit: (10) [lists] lists:member(writeln(1), [writeln(1), throw(good), writen(failed)]) 460 Call: (10) [system] writeln(1) 4611 462 Exit: (10) [system] writeln(1) 463X = writeln(1) ; 464 Redo: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1)) 465 Unify: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1)) 466 Call: (12) [lists] lists:member_([writen(failed)], _13424, throw(good)) 467 Unify: (12) [lists] lists:member_([writen(failed)], throw(good), throw(good)) 468 Exit: (12) [lists] lists:member_([writen(failed)], throw(good), throw(good)) 469 Exit: (11) [lists] lists:member_([throw(good), writen(failed)], throw(good), writeln(1)) 470 Exit: (10) [lists] lists:member(throw(good), [writeln(1), throw(good), writen(failed)]) 471 Call: (10) [system] throw(good) 472ERROR: Unhandled exception: good 473*/ 474 475set_leash_vis(OldL,OldV):- '$leash'(_, OldL),'$visible'(_, OldV),!. 476:- totally_hide(set_leash_vis/2). 477 478next_rtrace:- (nortrace;(rtrace,trace,notrace(fail))). 479:- totally_hide(next_rtrace/0). 480 481 482rtrace(Goal):- notrace(tracing)-> rtrace0((trace,Goal)) ; 483 setup_call_cleanup(current_prolog_flag(debug,WasDebug), 484 rtrace0((trace,Goal)),(set_prolog_flag(debug,WasDebug),notrace(stop_rtrace))). 485rtrace0(Goal):- 486 setup_call_cleanup(notrace((current_prolog_flag(debug,O),rtrace)), 487 (trace,Goal,notrace,deterministic(YN), 488 (YN == true->!;next_rtrace)), 489 notrace(set_prolog_flag(debug,O))). 490 491:- '$hide'(rtrace/1). 492:- '$hide'(rtrace0/1). 493:- '$set_predicate_attribute'(rtrace/1, hide_childs, true). 494:- '$set_predicate_attribute'(rtrace0/1, hide_childs, false).
502rtrace_break(Goal):- \+ maybe_leash, !, rtrace(Goal). 503rtrace_break(Goal):- stop_rtrace,trace,debugCallWhy(rtrace_break(Goal),Goal). 504%:- totally_hide(rtrace_break/1). 505:- '$set_predicate_attribute'(rtrace_break/1, hide_childs, false). 506 507 508 509 510:- '$hide'(quietly/1). 511%:- if_may_hide(totally_hide(notrace/1, hide_childs, 1)). 512%:- if_may_hide(totally_hide(notrace/1)). 513:- totally_hide(system:tracing/0). 514:- totally_hide(system:notrace/0). 515:- totally_hide(system:notrace/1). 516:- totally_hide(system:trace/0).
522ftrace(Goal):- restore_trace(( 523 visible(-all),visible(+unify), 524 visible(+fail),visible(+exception), 525 maybe_leash(-all),maybe_leash(+exception),trace,Goal)). 526 527 528/* 529:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)), 530 forall(source_file(M:H,S), 531 ignore((functor(H,F,A), 532 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))), 533 ignore(((\+ predicate_property(M:H,transparent), module_transparent(M:F/A), \+ atom_concat('__aux',_,F), 534 debug(modules,'~N:- module_transparent((~q)/~q).~n',[F,A]))))))))). 535*/ 536%:- use_module(library(logicmoo_util_common)). 537%:- fixup_exports. 538:- totally_hide('$toplevel':save_debug). 539:- totally_hide('$toplevel':toplevel_call/1). 540:- totally_hide('$toplevel':residue_vars(_,_)). 541:- totally_hide('$toplevel':save_debug). 542:- totally_hide('$toplevel':no_lco).