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 logicmoo@gmail.com ; 7% Version: '$FILENAME.pl' 1.0.0 8% Revision: $Revision: 1.1 $ 9% Revised At: $Date: 2021/07/11 21:57:28 $ 10% Licience: LGPL 11% =================================================================== 12*/ 13:- if((prolog_load_context(source,F),prolog_load_context(file,F))). 14:- module(must_sanity,[]). 15:- endif. 16:- use_module(logicmoo_startup). 17:- define_into_module( 18 [ 19 must/1, % Goal must succeed at least once once 20 must_once/1, % Goal must succeed at most once 21 must_det/1, % Goal must succeed determistically 22 sanity/1, % like assertion but adds trace control 23 %nop/1, % syntactic comment 24 scce_orig/3, 25 must_or_rtrace/1 26 ]). 27%:- endif.
34%:- discontiguous '$exported_op'/3. 35:- meta_predicate 36 must( ), 37 must_once( ), 38 must_det( ), 39 nop( ), 40 sanity( ), 41 %must_or_rtrace_mep(M,E,*), 42 scce_orig( , , ). 43 44:- set_module(class(library)). 45% % % OFF :- system:use_module(library(logicmoo_utils_all)). 46 47:- system:reexport(library(debug),[debug/3]). 48:- system:reexport(library(logicmoo_common)). 49 50% TODO Make a speed,safety,debug Triangle instead of these flags 51:- create_prolog_flag(runtime_must,debug,[type(term)]).
Wrap must/1 over parts of your code you do not trust
If your code fails.. it will rewind to your entry block (at the scope of this declaration) and invoke rtrace/1 .
If there are 50 steps to your code, it will save you from pushing creep
50 times.
Instead it turns off the leash to allow you to trace with your eyeballs instead of your fingers.
% must( :Goal) is semidet.
Must Be Successfull.
68must(MGoal):- (call(MGoal)*->true;must_0(MGoal)). 69must_0(MGoal):- quietly(get_must(MGoal,Must))-> call(Must). 70 71 72 73:- meta_predicate(deterministic_tf( , )). 74deterministic_tf(G, F) :- 75 , 76 deterministic(F), 77 otherwise. /* prevent tail recursion */ 78 79:- meta_predicate(was_cut( )). 80was_cut(Cut):- nonvar(Cut), strip_module(Cut,_,(!)). 81 82:- meta_predicate(mor_event( )). 83 84handle_mor_event(e(M,E,Err,G)):- !, call_cleanup(handle_mor_event(e(Err,G)),wdmsg(mor_e(M,E,Err,G))). 85handle_mor_event(f(M,E,G)):- !, call_cleanup(handle_mor_event(f(G)),wdmsg(mor_f(M,E,G))). 86handle_mor_event(e(E,_)):- !, handle_mor_event(E). 87handle_mor_event(e(Err,G)):- 88 wdmsg(mor_e(Err,G)), dumpST,!, 89 wdmsg(mor_e(Err,G)), ignore(rtrace(G)), 90 throw(Err). 91 92handle_mor_event(f(G)):- notrace(t_l:rtracing),!,wdmsg(warn(f0(G))),. 93handle_mor_event(f(G)):- 94 wdmsg(f1(G)), dumpST,!, 95 wdmsg(f2(G)), rtrace(G),!, 96 wdmsg(failed_must_or_rtrace(i3,G)), dtrace(G). 97 98mor_event(E):- handle_mor_event(E). 99mor_event(E):- throw(E). 100 101:- meta_predicate(must_or_rtrace_mep( , , )). 102must_or_rtrace_mep(M,E,(G1,Cut)):- was_cut(Cut),!,must_or_rtrace_mep(M,E,G1),!. 103must_or_rtrace_mep(M,E,(G1,Cut,G2)):- was_cut(Cut),!,must_or_rtrace_mep(M,E,G1),!,must_or_rtrace_mep(M,G1,G2). 104must_or_rtrace_mep(M,E,(G1,G2)):- !, (*->;throw(f(M,E,G1))). 105must_or_rtrace_mep(M,E,P):- predicate_property(P,number_of_clauses(_)),!, 106 findall(B,clause(P,B),Bs),!,(Bs==[]->throw(f(M,E,P));(mor_list_to_disj(fail,Bs,ORs),(*->throw(f(M,E,P))))). 107must_or_rtrace_mep(M,E,G):- catch(G,Er,throw(e(M,E,Er,G)))*->true;throw(f(M,E,G)). 108 109mor_list_to_disj(_,[X],X):-!. 110mor_list_to_disj(L,[A|B],(A;BB)):- mor_list_to_disj(L,B,BB). 111mor_list_to_disj(End,[],End):-!. 112 113:- meta_predicate(must_or_rtrace( )). 114 115must_or_rtrace(G):- tracing,!,call(G). 116must_or_rtrace((G1,Cut)):- was_cut(Cut),!,must_or_rtrace(G1),!. 117must_or_rtrace((G1,Cut,G2)):- was_cut(Cut),!,must_or_rtrace(G1),!,must_or_rtrace(G2). 118must_or_rtrace((G1,G2)):- !,( catch(G1,Ex,mor_event(e(Ex,G1)))*->must_or_rtrace(G2);mor_event(f(G1))). 119must_or_rtrace(G):- catch(G,Ex,mor_event(e(Ex,G)))*-> true; mor_event(f(G)). 120 121%:- export(notrace/1). 122%:- meta_predicate(notrace(:)). 123%notrace(G):- call(G). 124:- redefine_system_predicate(system:notrace/1). 125:- '$hide'(system:notrace/1). 126 127%must_or_rtrace_mep(M,E,G):- get_must_l(G,Must),!,call(Must). 128%must_or_rtrace_mep(M,E,G):- catch(G,Err,(dmsg(error_must_or_rtrace(Err)->G),ignore(rtrace(G)),throw(Err))) *->true; ftrace(G).
135get_must(Goal,CGoal):- (skipWrapper ; tlbugger:skipMust),!,CGoal = Goal. 136%get_must(M:Goal,M:CGoal):- must_be(nonvar,Goal),!,get_must(Goal,CGoal). 137get_must(quietly(Goal),quietly(CGoal)):- current_prolog_flag(runtime_safety,3), !, get_must(Goal,CGoal). 138get_must(quietly(Goal),CGoal):- !,get_must((quietly(Goal)*->true;Goal),CGoal). 139get_must(Goal,CGoal):- keep_going,!,CGoal=must_keep_going(Goal). 140get_must(Goal,CGoal):- hide_non_user_console,!,get_must_type(rtrace,Goal,CGoal). 141get_must(Goal,CGoal):- current_prolog_flag(runtime_must,How), How \== none, !, get_must_type(How,Goal,CGoal). 142get_must(Goal,CGoal):- current_prolog_flag(runtime_debug,2), !, 143 (CGoal = (on_x_debug(Goal) *-> true; debugCallWhy(failed(on_f_debug(Goal)),Goal))). 144get_must(Goal,CGoal):- get_must_l(Goal,CGoal). 145 146get_must_l(Goal,CGoal):- 147 (CGoal = (catchv(Goal,E, 148 ignore_each(((dumpST_error(must_ERROR(E,Goal)), %set_prolog_flag(debug_on_error,true), 149 rtrace(Goal),nortrace,dtrace(Goal),badfood(Goal))))) 150 *-> true ; (dumpST,ignore_each(((dtrace(must_failed_F__A__I__L_(Goal),Goal),badfood(Goal))))))). 151 152 153get_must_type(speed,Goal,Goal). 154get_must_type(warning,Goal,show_failure(Goal)). 155get_must_type(fail,Goal,Goal). 156get_must_type(rtrace,Goal,on_f_rtrace(Goal)). 157get_must_type(keep_going,Goal,must_keep_going(Goal)). 158get_must_type(retry,Goal,must_retry(Goal)). 159get_must_type(How,Goal,CGoal):- 160 (How == assertion -> CGoal = (Goal*->true;call(prolog_debug:assertion_failed(fail, must(Goal)))); 161 (How == error ; true ) 162 -> CGoal = (Goal*-> true; (rtrace(Goal),throw(failed_must(Goal))))). 163 164must_retry(Call):- 165 (repeat, (catchv(Call,E,(dmsg(E:Call),fail)) *-> true ; 166 catch((ignore(rtrace(Call)),leash(+all),visible(+all), 167 repeat,wdmsg(failed(Call)),trace,Call,fail),'$aborted',true))). 168 169must_keep_going(Goal):- 170 locally(set_prolog_flag(debug_on_error,false), 171 ((catch(Goal,E, 172 notrace(((dumpST_error(sHOW_MUST_go_on_xI__xI__xI__xI__xI_(E,Goal)),ignore(rtrace(Goal)),badfood(Goal))))) 173 *-> true ; 174 notrace(dumpST_error(sHOW_MUST_go_on_failed_F__A__I__L_(Goal))),ignore(rtrace(Goal)),badfood(Goal)))). 175 176 177:- '$hide'(get_must/2).
like assertion/1 but adds trace control
187sanity(_):- notrace(current_prolog_flag(runtime_safety,0)),!. 188sanity(_):-!. 189sanity(Goal):- \+ ( nb_current('$inprint_message', Messages), Messages\==[] ), 190 \+ tracing, 191 \+ current_prolog_flag(runtime_safety,3), 192 \+ current_prolog_flag(runtime_debug,0), 193 (current_prolog_flag(runtime_speed,S),S>1), 194 !, (1 is random(10)-> must(Goal) ; true). 195sanity(Goal):- (current_prolog_flag(debug,true)->quietly(Goal);nop(Goal)),!. 196sanity(Goal):- keep_going,!,dmsg(failed_sanity(Goal)=keep_going),fail. 197sanity(_):- dumpST,break,fail. 198sanity(Goal):- ignore(setup_call_cleanup(wdmsg(begin_FAIL_in(Goal)),rtrace(Goal),wdmsg(end_FAIL_in(Goal)))),!,dtrace(assertion(Goal)).
204must_once(Goal):- must(Goal),!.
212% must_det(Goal):- current_prolog_flag(runtime_safety,0),!,must_once(Goal). 213must_det(Goal):- \+ current_prolog_flag(runtime_safety,3),!,must_once(Goal). 214must_det(Goal):- must_once(Goal),!. 215/* 216must_det(Goal):- must_once((Goal,deterministic(YN))),(YN==true->true;dmsg(warn(nondet_exit(Goal)))),!. 217must_det(Goal):- must_once((Goal,deterministic(YN))),(YN==true->true;throw(nondet_exit(Goal))). 218*/ 219 220:- redefine_system_predicate(system:nop/1). 221:- abolish(system:nop/1),asserta(system:nop(_)).
229/* 230scce_orig(Setup,Goal,Cleanup):- 231 \+ \+ '$sig_atomic'(Setup), 232 catch( 233 ((Goal, deterministic(DET)), 234 '$sig_atomic'(Cleanup), 235 (DET == true -> ! 236 ; (true;('$sig_atomic'(Setup),fail)))), 237 E, 238 ('$sig_atomic'(Cleanup),throw(E))). 239 240:- abolish(system:scce_orig,3). 241 242 243[debug] ?- scce_orig( (writeln(a),trace,start_rtrace,rtrace) , (writeln(b),member(X,[1,2,3]),writeln(c)), writeln(d)). 244a 245b 246c 247d 248X = 1 ; 249a 250c 251d 252X = 2 ; 253a 254c 255d 256X = 3. 257 258 259*/ 260%:- meta_predicate(mquietly(?)). 261:- module_transparent(mquietly/1). 262:- export(mquietly/1). 263%:- system:import(mquietly/1). 264mquietly(Var):- var(Var),!,trace_or_throw(var_mquietly(Var)). 265%mquietly((G1,G2)):- !, call(G1),mquietly(G2). 266%mquietly((G1;G2)):- !, call(G1);mquietly(G2). 267%mquietly(M:(G1,G2)):- !, call(M:G1),mquietly(M:G2). 268%mquietly(M:(G1;G2)):- !, call(M:G1);mquietly(M:G2). 269mquietly(G):- call(G). 270 271:- '$hide'(mquietly/1). 272%:- '$hide'(mquietly/2). 273 274mquietly_if(false,_):- !. 275mquietly_if(_,G):- mquietly(G). 276 277 278scce_orig(Setup,Goal,Cleanup):- 279 HdnCleanup = mquietly_if(true,Cleanup), 280 setup_call_cleanup(Setup, 281 ((Goal,deterministic(DET)), 282 (notrace(DET == true) 283 -> ! 284 ;((Cleanup,notrace(nb_setarg(1,HdnCleanup,false))) 285 ;(Setup,notrace(nb_setarg(1,HdnCleanup, true)),notrace(fail))))), 286 HdnCleanup). 287 288 289scce_orig1(Setup,Goal,Cleanup):- 290 \+ \+ '$sig_atomic'(Setup), 291 catch( 292 ((Goal, notrace(deterministic(DET))), 293 '$sig_atomic'(Cleanup), 294 (notrace(DET == true) -> ! 295 ; (true;('$sig_atomic'(Setup),fail)))), 296 E, 297 ('$sig_atomic'(Cleanup),throw(E))). 298 299scce_orig0(Setup0,Goal,Cleanup0):- 300 notrace((Cleanup = notrace('$sig_atomic'(Cleanup0)),Setup = notrace('$sig_atomic'(Setup0)))), 301 \+ \+ , !, 302 (catch(Goal, E,(Cleanup,throw(E))) 303 *-> (tracing->(deterministic(DET));deterministic(DET)); (,!,fail)), 304 , 305 (notrace(DET == true) -> ! ; (true;(,fail))). 306 307'my_set_predicate_attribute'(M:F/A,B,C):- functor(P,F,A),'my_set_predicate_attribute'(M:P,B,C),!. 308'my_set_predicate_attribute'(F/A,B,C):- functor(P,F,A),'my_set_predicate_attribute'(P,B,C),!. 309 310'my_set_predicate_attribute'(A,B,C):- 311 current_prolog_flag(access_level,system),!, 312 'my_set_predicate_attribute2'(A,B,C). 313'my_set_predicate_attribute'(A,B,C):- 314 current_prolog_flag(access_level,Was), 315 setup_call_cleanup(set_prolog_flag(access_level,system), 316 'my_set_predicate_attribute2'(A,B,C),set_prolog_flag(access_level,Was)). 317 318'my_set_predicate_attribute2'(A,B,C):- 319 redefine_system_predicate(A), '$set_predicate_attribute'(A,B,C),!. 320 321 322%:- '$hide'(scce_orig/3). 323%:- 'my_set_predicate_attribute'(scce_orig(_,_,_), hide_childs, true). 324 325%:- 'my_set_predicate_attribute'(notrace/1, hide_childs, true). 326 327%:- '$hide'(system:setup_call_catcher_cleanup/4). 328%:- 'my_set_predicate_attribute'(system:setup_call_catcher_cleanup/4, hide_childs, false). 329 330%:- redefine_system_predicate(call_cleanup(_,_)). 331%:- '$hide'(system:call_cleanup/2). 332%:- 'my_set_predicate_attribute'(call_cleanup/2, hide_childs, false). 333 334 335scce_orig2(Setup,Goal,Cleanup):- 336 \+ \+ '$sig_atomic'(Setup), 337 catch( 338 ((Goal, deterministic(DET)), 339 '$sig_atomic'(Cleanup), 340 (DET == true -> ! 341 ; (true;('$sig_atomic'(Setup),fail)))), 342 E, 343 ('$sig_atomic'(Cleanup),throw(E))). 344 345 346 347% % % OFF :- system:reexport(library('debuggery/first')). 348% % % OFF :- system:reexport(library('debuggery/ucatch')). 349% % % OFF :- system:reexport(library('debuggery/dmsg')). 350% % % OFF :- system:reexport(library('debuggery/rtrace')). 351% % % OFF :- system:reexport(library('debuggery/bugger')). 352% % % OFF :- system:reexport(library('debuggery/dumpst')). 353% % % OFF :- system:reexport(library('debuggery/frames')). 354 355 356 357:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)), 358 forall(source_file(M:H,S), 359 ignore((functor(H,F,A), 360 ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))), 361 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]))))))))).
Utility LOGICMOO_MUST_SANITY
This module includes predicate utilities that allows program to detect unwanted failures. @author Douglas R. Miles @license LGPL */