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)]).

 must(:Goal) is nondet

Goal must succeed at least once once

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   G,
   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))),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(+,0,:)).  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)):- !, (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),(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).

 get_must(?Goal, ?CGoal) is semidet

Get Must Be Successfull.

  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).

 sanity(:Goal) is det

Optional Sanity Checking.

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)).

 must_once(:Goal) is det

Goal must succeed at most once

  204must_once(Goal):- must(Goal),!.

 must_det(:Goal) is det

Goal must succeed determistically

  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(_)).

 nop(:Goal) is det

Comments out code without losing syntax

  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   \+ \+ Setup, !,
  302   (catch(Goal, E,(Cleanup,throw(E)))
  303      *-> (tracing->(deterministic(DET));deterministic(DET)); (Cleanup,!,fail)),
  304     Cleanup,
  305     (notrace(DET == true) -> ! ; (true;(Setup,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]))))))))).