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(swi_backport, 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 34:-ensure_loaded(('cyc_pl/cyc.pl')). 35 36/* 37:- if( predicate_property(cyc:debugFmt(_), defined)). 38:- abolish(cyc:debugFmt/1). 39:- endif. 40 41:- if( predicate_property(cyc:debugFmt(_,_), defined)). 42:- abolish(cyc:debugFmt/2). 43:- else. 44:- endif. 45:- if(\+ predicate_property(nop(_),defined)). 46:- endif. 47:- if( \+ predicate_property(term_to_string(_,_),defined)). 48:- endif. 49%:- if(\+ predicate_property(alldiscontiguous(),defined)). 50%:- endif. 51 52*/ 53 54cls:-shell(cls). 55 56:-asserta(user:library_directory('/opt/logicmoo_workspace/packs_sys/logicmoo_utils/prolog/')). 57 58term_to_string(I,IS):- error_catch(string_to_atom(IS,I),_,fail),!. 59term_to_string(I,IS):- term_to_atom(I,A),string_to_atom(IS,A),!. 60alldiscontiguous:-!. 61cycdebugFmt(Stuff):-once(lmdebugFmt(Stuff)). 62cycdebugFmt(F,A):-once(lmdebugFmt(F,A)). 63 64nop(_). 65 66string_parse_structure_opts_547(Parser, _In, _M, Options,Options2):- 67 sgml:set_parser_options(Parser, Options, Options1), 68 Options2=Options1. 69 70:- module_transparent(setup_call_cleanup/3). 71 72setup_call_cleanup(X,Y,Z):- ,!,call_cleanup(Y,Z). 73% atomic_list_concat_aiml(X,Y,Z):- atomic_list_concat_aiml(X,Y,Z). 74 75 76 77:- meta_predicate('$with_unlocked_pred_local'(,)). 78'$with_unlocked_pred_local'(MP,Goal):- strip_module(MP,M,P),Pred=M:P, 79 (predicate_property(Pred,foreign)-> true ; 80 ( 81 ('$get_predicate_attribute'(Pred, system, OnOff)->true;throw('$get_predicate_attribute'(Pred, system, OnOff))), 82 (==(OnOff,0) -> ; 83 setup_call_cleanup('$set_predicate_attribute'(Pred, system, 0), 84 catch(Goal,E,throw(E)),'$set_predicate_attribute'(Pred, system, 1))))). 85 86:- meta_predicate(totally_hide()). 87totally_hide(MP):- strip_module(MP,M,P),Pred=M:P, 88 % (current_prolog_flag(runtime_debug,N), N>2) -> unhide(Pred) ; 89 '$with_unlocked_pred_local'(Pred, 90 (('$set_predicate_attribute'(Pred, trace, 0),'$set_predicate_attribute'(Pred, hide_childs, 1)))). 91 92:-totally_hide(totally_hide/1). 93 94 95 96%:- totally_hide(quietly/1).
104rtrace:- start_rtrace,trace. 105 106:- 'totally_hide'(rtrace/0). 107 108start_rtrace:- 109 leash(-all), 110 assert(t_l:rtracing), 111 set_prolog_flag(access_level,system), 112 push_guitracer, 113 set_prolog_flag(gui_tracer,false), 114 visible(+all), 115 visible(+exception), 116 maybe_leash(+exception). 117 118:- 'totally_hide'(start_rtrace/0).
124srtrace:- notrace, set_prolog_flag(access_level,system), rtrace. 125 126:- totally_hide(srtrace/0).
134stop_rtrace:- 135 notrace, 136 maybe_leash(+all), 137 visible(+all), 138 maybe_leash(+exception), 139 retractall(t_l:rtracing), 140 !. 141 142:- 'totally_hide'(stop_rtrace/0). 143:- system:import(stop_rtrace/0). 144 145nortrace:- stop_rtrace,ignore(pop_tracer). 146 147:- totally_hide(nortrace/0). 148 149 150:- thread_local('$leash_visible'/2).
! restore_trace( :Goal) is nondet.
restore Trace.
160restore_trace(Goal):- 161 setup_call_cleanup( 162 push_leash_visible, 163 scce_orig(push_tracer,Goal,pop_tracer), 164 restore_leash_visible). 165 166restore_trace0(Goal):- 167 '$leash'(OldL, OldL),'$visible'(OldV, OldV), 168 scce_orig(restore_leash_visible, 169 ((Goal*-> (push_leash_visible, '$leash'(_, OldL),'$visible'(_, OldV)) ; fail)), 170 ('$leash'(_, OldL),'$visible'(_, OldV))). 171 172:- totally_hide(system:'$leash'/2). 173:- totally_hide(system:'$visible'/2). 174 175push_leash_visible:- notrace((('$leash'(OldL0, OldL0),'$visible'(OldV0, OldV0), asserta('$leash_visible'(OldL0,OldV0))))). 176restore_leash_visible:- notrace((('$leash_visible'(OldL1,OldV1)->('$leash'(_, OldL1),'$visible'(_, OldV1));true))). 177 178% restore_trace(Goal):- setup_call_cleanup(get_trace_reset(Reset),Goal,notrace(Reset)). 179:- totally_hide(restore_trace/0).
187push_guitracer:- notrace(ignore(((current_prolog_flag(gui_tracer, GWas);GWas=false),asserta(t_l:wasguitracer(GWas))))). 188:- totally_hide(push_guitracer/0).
195pop_guitracer:- notrace(ignore(((retract(t_l:wasguitracer(GWas)),set_prolog_flag(gui_tracer, GWas))))). 196:- totally_hide(pop_guitracer/0).
202maybe_leash(Some):- notrace((maybe_leash->leash(Some);true)). 203:- totally_hide(maybe_leash/1). 204 205maybe_leash:- notrace((\+ current_prolog_flag(runtime_must,keep_going), \+ non_user_console)). 206 207non_user_console:- !,fail. 208non_user_console:- \+ stream_property(current_input, tty(true)),!. 209non_user_console:- \+ stream_property(current_input,close_on_abort(false)). 210 211 212 213rtrace(Goal):- notrace(tracing)-> rtrace0((trace,Goal)) ; 214 setup_call_cleanup(current_prolog_flag(debug,WasDebug), 215 rtrace0((trace,Goal)),(set_prolog_flag(debug,WasDebug),notrace(stop_rtrace))). 216rtrace0(Goal):- 217 setup_call_cleanup(notrace((current_prolog_flag(debug,O),rtrace)), 218 (trace,Goal,notrace,deterministic(YN), 219 (YN == true->!;next_rtrace)), 220 notrace(set_prolog_flag(debug,O))). 221 222 223scce_orig(Setup,Goal,Cleanup):- 224 \+ \+ '$sig_atomic'(Setup), 225 catch( 226 ((Goal, deterministic(DET)), 227 '$sig_atomic'(Cleanup), 228 (DET == true -> ! 229 ; (true;('$sig_atomic'(Setup),fail)))), 230 E, 231 ('$sig_atomic'(Cleanup),throw(E))). 232 233 234set_leash_vis(OldL,OldV):- '$leash'(_, OldL),'$visible'(_, OldV),!. 235:- totally_hide(set_leash_vis/2). 236 237next_rtrace:- (nortrace;(rtrace,trace,notrace(fail))). 238:- 'totally_hide'(next_rtrace/0). 239 240 241 242:- '$hide'(rtrace/1). 243:- '$hide'(rtrace0/1). 244:- '$set_predicate_attribute'(rtrace/1, hide_childs, 1). 245:- '$set_predicate_attribute'(rtrace0/1, hide_childs, 0).
251get_trace_reset((notrace,set_prolog_flag(debug,WasDebug),CC3,'$visible'(_, OldV),'$leash'(_, OldL),RestoreTrace)):- 252 (notrace(tracing) -> (notrace,RestoreTrace = trace) ; RestoreTrace = notrace), 253 '$leash'(OldL, OldL),'$visible'(OldV, OldV), 254 (current_prolog_flag(debug,true)->WasDebug=true;WasDebug=false), 255 (current_prolog_flag(gui_tracer, GWas)->CC3=set_prolog_flag(gui_tracer, GWas);CC3=true),!, 256 . 257 258:- totally_hide(get_trace_reset/1). 259:- totally_hide(get_trace_reset/1).
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:- '$hide'(quietly/1). 285%:- if_may_hide('totally_hide'(notrace/1, hide_childs, 1)). 286%:- if_may_hide('totally_hide'(notrace/1)). 287:- totally_hide(system:tracing/0). 288:- totally_hide(system:notrace/0). 289:- totally_hide(system:notrace/1). 290:- totally_hide(system:trace/0). 291 292 293 294/** 295 * Simulation of some SWI-Prolog conditional compilation. 296 * 297 * Warranty & Liability 298 * To the extent permitted by applicable law and unless explicitly 299 * otherwise agreed upon, XLOG Technologies GmbH makes no warranties 300 * regarding the provided information. XLOG Technologies GmbH assumes 301 * no liability that any problems might be solved with the information 302 * provided by XLOG Technologies GmbH. 303 * 304 * Rights & License 305 * All industrial property rights regarding the information - copyright 306 * and patent rights in particular - are the sole property of XLOG 307 * Technologies GmbH. If the company was not the originator of some 308 * excerpts, XLOG Technologies GmbH has at least obtained the right to 309 * reproduce, change and translate the information. 310 * 311 * Reproduction is restricted to the whole unaltered document. Reproduction 312 * of the information is only allowed for non-commercial uses. Selling, 313 * giving away or letting of the execution of the library is prohibited. 314 * The library can be distributed as part of your applications and libraries 315 * for execution provided this comment remains unchanged. 316 * 317 * Restrictions 318 * Only to be distributed with programs that add significant and primary 319 * functionality to the library. Not to be distributed with additional 320 * software intended to replace any components of the library. 321 * 322 * Trademarks 323 * Jekejeke is a registered trademark of XLOG Technologies GmbH. 324 */ 325 326 327% sys_stack(-List) 328:- private sys_stack/1. 329:- thread_local sys_stack/1. 330 331:- private sys_push_stack/1. 332sys_push_stack(C) :- 333 retract(sys_stack(L)), !, 334 assertz(sys_stacK([C|L])). 335sys_push_stack(C) :- 336 assertz(sys_stack([C])). 337 338% sys_peek_stack 339:- private sys_peek_stack/0. 340sys_peek_stack :- 341 sys_stack([off|_]). 342 343% sys_pop_stack 344:- private sys_pop_stack/0. 345sys_pop_stack :- 346 retract(sys_stack([_,X|L])), !, 347 assertz(sys_stack([X|L])). 348sys_pop_stack :- 349 retract(sys_stack([_])), !. 350sys_pop_stack :- 351 throw(error(syntax_error(unbalanced_directive),_)). 352 353% user:term_expansion(+Term, -Term) 354:- public user:term_expansion/2. 355:- multifile user:term_expansion/2. 356:- meta_predicate user:term_expansion(-1,-1). 357userterm_expansion((:- if(C)), unit) :- !, 358 ( sys_peek_stack 359 -> sys_push_stack(off) 360 ; 361 -> sys_push_stack(on) 362 ; sys_push_stack(off)). 363userterm_expansion((:- elif(C)), unit) :- !, 364 ( sys_peek_stack 365 -> D = off 366 ; D = on), sys_pop_stack, 367 ( sys_peek_stack 368 -> sys_push_stack(off) 369 ; D = off, 370 -> sys_push_stack(on) 371 ; sys_push_stack(off)). 372userterm_expansion((:- else), unit) :- !, 373 ( sys_peek_stack 374 -> D = off 375 ; D = on), sys_pop_stack, 376 ( sys_peek_stack 377 -> sys_push_stack(off) 378 ; D = off 379 -> sys_push_stack(on) 380 ; sys_push_stack(off)). 381userterm_expansion((:- endif), unit) :- !, sys_pop_stack. 382userterm_expansion(unit, _) :- !, fail. 383userterm_expansion(_, unit) :- sys_peek_stack, !. 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401% WAS EOF 402:- module_transparent(nortrace/0). 403 404:-thread_local(t_l:rtracing/0). 405:-thread_local(t_l:tracer_reset/1). 406:-thread_local(t_l:wasguitracer/1). 407:-thread_local(t_l:wastracer/1). 408 409:- 'meta_predicate'(call_call()). 410call_call(G):-call(G). 411 412 413:- meta_predicate 414 rtrace(), 415 restore_trace(), 416 on_x_debug(), 417 on_f_rtrace(), 418 419 rtrace_break(), 420 quietly(), 421 ftrace().
429% on_f_rtrace(Goal):- Goal *-> true; ((nortrace,notrace,debugCallWhy(failed(on_f_rtrace(Goal)),Goal)),fail). 430 431on_f_rtrace(Goal):- *-> true; (rtrace(Goal),debugCallWhy(on_f_rtrace(Goal),Goal)).
439on_x_debug(Goal):- 440 ((( tracing; t_l:rtracing),maybe_leash(+exception))) 441 -> 442 ; 443 (catchv(Goal,E,(ignore(debugCallWhy(on_x_debug(E,Goal),Goal)),throw(E)))). 444 445 446 447unhide(Pred):- '$set_predicate_attribute'(Pred, trace, true),mpred_trace_childs(Pred). 448 449 450:- multifile(user:prolog_exception_hook/4). 451:- dynamic(user:prolog_exception_hook/4). 452:- module_transparent(user:prolog_exception_hook/4). 453 454% Make sure interactive debugging is turned back on 455 456userprolog_exception_hook(error(_, _),_, _, _) :- leash(+all),fail. 457 458userprolog_exception_hook(error(_, _),_, _, _) :- fail, 459 notrace(( reset_tracer -> 460 maybe_leash -> 461 t_l:rtracing -> 462 leash(+all), 463 fail)).
But also may be break when excpetions are raised during Goal.
472% Version 1 473quietly(Goal):- \+ tracing,!,call(Goal). 474quietly(Goal):- notrace,call_cleanup(Goal,trace). 475 476% version 2 477quietly2(Goal):- \+ tracing -> ; (notrace,call_cleanup(scce_orig(notrace,Goal,trace),trace)). 478 479% version 3 480% quietly(Goal):- !, Goal. % for overiding 481quietly3(Goal):- \+ tracing -> ; 482 (notrace, 483 (((,deterministic(YN))) *-> 484 (YN == yes -> trace ; (trace;(notrace,fail))); 485 (trace,!,notrace(fail)))). 486 487 488 489deterministically_must(G):- call(call,G),deterministic(YN),true, 490 (YN==true -> true; 491 ((wdmsg(failed_deterministically_must(G)),(!)))),!.
?- 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.
532/*
533 ?- rtrace((member(X,[writeln(1),throw(good),writen(failed)]),X)).
534 Call: (10) [lists] lists:member(_13424, [writeln(1), throw(good), writen(failed)])
535 Unify: (10) [lists] lists:member(_13424, [writeln(1), throw(good), writen(failed)])
536 Call: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1))
537 Unify: (11) [lists] lists:member_([throw(good), writen(failed)], writeln(1), writeln(1))
538 Exit: (11) [lists] lists:member_([throw(good), writen(failed)], writeln(1), writeln(1))
539 Exit: (10) [lists] lists:member(writeln(1), [writeln(1), throw(good), writen(failed)])
540 Call: (10) [system] writeln(1)
5411
542 Exit: (10) [system] writeln(1)
543X = writeln(1) ;
544 Redo: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1))
545 Unify: (11) [lists] lists:member_([throw(good), writen(failed)], _13424, writeln(1))
546 Call: (12) [lists] lists:member_([writen(failed)], _13424, throw(good))
547 Unify: (12) [lists] lists:member_([writen(failed)], throw(good), throw(good))
548 Exit: (12) [lists] lists:member_([writen(failed)], throw(good), throw(good))
549 Exit: (11) [lists] lists:member_([throw(good), writen(failed)], throw(good), writeln(1))
550 Exit: (10) [lists] lists:member(throw(good), [writeln(1), throw(good), writen(failed)])
551 Call: (10) [system] throw(good)
552ERROR: Unhandled exception: good
553*/
562rtrace_break(Goal):- \+ maybe_leash, !, rtrace(Goal). 563rtrace_break(Goal):- stop_rtrace,trace,debugCallWhy(rtrace_break(Goal),Goal). 564%:- totally_hide(rtrace_break/1). 565:- '$set_predicate_attribute'(rtrace_break/1, hide_childs, false).
575ftrace(Goal):- restore_trace(( 576 visible(-all),visible(+unify), 577 visible(+fail),visible(+exception), 578 maybe_leash(-all),maybe_leash(+exception),trace,Goal)). 579 580 581 582:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)), 583 forall(source_file(M:H,S), 584 ignore((functor(H,F,A), 585 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))), 586 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]))))))))). 587 588:- use_module(library(logicmoo_util_common)). 589:- fixup_exports. 590:- totally_hide('$toplevel':save_debug). 591:- totally_hide('$toplevel':toplevel_call/1). 592:- totally_hide('$toplevel':residue_vars(_,_)). 593:- totally_hide('$toplevel':save_debug). 594:- totally_hide('$toplevel':no_lco).