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
   14% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_catch.pl
   15:- module(ucatch,
   16          [ !/1,
   17            addLibraryDir/0,
   18            get_main_error_stream/1,
   19            get_thread_current_error/1,
   20            source_variables_l/1,
   21            as_clause_no_m/3,
   22            as_clause_w_m/4,
   23            as_clause_w_m/5,
   24            source_module/1,
   25            bad_functor/1,
   26            main_self/1,
   27            set_main_error/0,
   28            find_main_eror/1,
   29            set_mains/0,
   30            current_why/1,
   31            thread_self_main/0,
   32            badfood/1,
   33            unsafe_safe/2,
   34            % quietly/1,
   35            doall_and_fail/1,
   36            quietly_must/1,
   37            on_x_f/3,
   38            
   39            hide_trace/1,
   40            (block)/2,
   41            (block3)/3,
   42            with_current_why/2,
   43            %bubbled_ex/1,
   44            %bubbled_ex_check/1,
   45            catchv/3,
   46            flag_call/1,
   47            current_source_file/1,current_source_location0/2,
   48            lmcache:current_main_error_stream/1,
   49            lmcache:thread_current_input/2,
   50            dbgsubst/4,
   51            dbgsubst0/4,
   52            ddmsg/1,
   53            ddmsg/2,
   54            ddmsg_call/1,
   55            det_lm/2,
   56            dif_safe/2,
   57            dumpST_error/1,
   58            errx/0,
   59            format_to_error/2,
   60            fresh_line_to_err/0,
   61            functor_catch/3,
   62            functor_safe/3,
   63            
   64            ib_multi_transparent33/1,
   65            if_defined/1,if_defined/2,
   66            input_key/1,
   67            is_ftCompound/1,ftCompound/1, 
   68            not_ftCompound/1,
   69            is_ftNameArity/2,
   70            is_ftNonvar/1,ftNonvar/1,
   71            is_ftVar/1,ftVar/1,
   72
   73            is_main_thread/0,
   74            is_pdt_like/0,
   75            is_release/0,
   76            need_speed/0,
   77            allow_unsafe_code/0,
   78            keep/2,
   79            loading_file/1,
   80            on_x_log_throw/1,
   81            %on_x_log_throwEach/1,
   82            on_x_log_cont/1,
   83            on_x_log_fail/1,
   84            skip_failx_u/1,
   85            on_xf_log_cont/1,
   86            on_xf_log_cont_l/1,
   87            maplist_safe/2,
   88            maplist_safe/3,
   89            module_functor/4,
   90
   91            trace_or_throw/1,
   92            trace_or_throw/1,
   93
   94            %must/1,
   95            must2/2,
   96            must_det_u/1,
   97            %must_det_dead/2,
   98            must_l/1,
   99
  100            must_det_l/1,
  101            must_det_l_pred/2,
  102            call_must_det/2,
  103            call_each/2,
  104            p_call/2,
  105
  106            nd_dbgsubst/4,
  107            nd_dbgsubst1/5,
  108            nd_dbgsubst2/4,
  109
  110            not_is_release/0,
  111            one_must/2,
  112            one_must_det/2,
  113            % sanity/1,
  114            sanity2/2,
  115            save_streams/0,
  116            save_streams/1,
  117            set_block_exit/2,
  118            showHiddens/0,
  119            show_new_src_location/1,
  120            show_new_src_location/2,
  121            show_source_location/0,
  122            skipWrapper/0,
  123            slow_sanity/1,
  124            strip_arity/3,
  125            strip_f_module/2,
  126            get_thread_current_error/1,
  127            throwNoLib/0,
  128            to_m_f_arity_pi/5,
  129            to_mpi_matcher/2,
  130            to_pi0/3,
  131            warn_bad_functor/1,
  132            when_defined/1,
  133            with_main_error_to_output/1,
  134            with_current_io/1,
  135            with_error_to_main/1,
  136            with_dmsg_to_main/1,
  137            with_main_input/1,
  138            with_main_io/1,
  139            with_preds/6,
  140            without_must/1,
  141            hide_non_user_console/0,
  142            y_must/2,
  143            vsubst/4,
  144            must_find_and_call/1
  145
  146
  147          ]).  148
  149:- use_module(library(dmsg)).  150:- use_module(library(must_trace)).  151
  152vsubst(In,B,A,Out):-var(In),!,(In==B->Out=A;Out=In).
  153vsubst(In,B,A,Out):-subst(In,B,A,Out).
  154
  155% :- use_module(logicmoo_util_prolog_streams).
  156:- thread_self(Goal),assert(lmcache:thread_main(user,Goal)).  157
  158main_self(main).
  159main_self(W):-atom(W),atom_concat('pdt_',_,W),!.
  160main_self(W):-atom(W),atom_concat('client',_,W),!.
  161main_self(W):-lmcache:thread_main(user,W),!.
  162
  163thread_self_main:- zotrace((thread_self(W),!,main_self(W))).
 hide_non_user_console is semidet
Not User Console.
  169hide_non_user_console:-thread_self_main,!,fail.
  170hide_non_user_console:-current_input(In),stream_property(In,tty(true)),!,fail.
  171hide_non_user_console:-current_prolog_flag(debug_threads,true),!,fail.
  172hide_non_user_console:-current_input(In),stream_property(In, close_on_abort(true)).
  173hide_non_user_console:-current_input(In),stream_property(In, close_on_exec(true)).
  174
  175
  176/*
  177:- if(\+ current_predicate(system:nop/1)).
  178:- user:ensure_loaded(logicmoo_util_supp).
  179:- endif.
  180*/
  181
  182
  183:- meta_predicate
  184
  185
  186		block3(+, :, ?),
  187		catchv(0, ?, 0),
  188
  189		if_defined(:),
  190		if_defined(:, 0),
  191		ddmsg_call(0),
  192
  193                on_xf_log_cont(0),
  194
  195		skip_failx_u(0),
  196		on_xf_log_cont_l(0),
  197		on_x_log_throw(0),
  198                with_current_why(*,0),
  199                with_only_current_why(*,0),
  200
  201
  202		on_x_log_cont(0),
  203		on_x_log_fail(0),
  204
  205
  206        % must(0),
  207        must2(+,0),
  208        must_find_and_call(0),
  209        must_det_u(0),
  210        %must_det_dead(0, 0),
  211
  212        must_det_l(0),
  213        must_det_l_pred(1,+),
  214        call_must_det(1,+),
  215        call_each(*,+),
  216        p_call(*,+),
  217
  218        must_l(0),
  219        one_must(0, 0),
  220        one_must_det(0, 0),
  221        unsafe_safe(0,0),
  222        % sanity(0),
  223        sanity2(+,0),
  224        slow_sanity(0),
  225        to_mpi_matcher(?, ?),
  226        when_defined(:),
  227        with_main_error_to_output(0),
  228        with_current_io(0),
  229        with_dmsg_to_main(0),
  230        with_error_to_main(0),
  231        with_main_input(0),
  232        with_main_io(0),
  233        with_preds(?, ?, ?, ?, ?, 0),
  234        without_must(0),
  235        %on_x_log_throwEach(0),
  236        y_must(?, 0).  237
  238:- module_transparent
  239        !/1,
  240        addLibraryDir/0,
  241        as_clause_no_m/3,
  242        as_clause_w_m/4,
  243        as_clause_w_m/5,
  244        bad_functor/1,
  245        badfood/1,
  246        (block)/2,
  247        %bubbled_ex/1,
  248        %bubbled_ex_check/1,
  249        current_source_file/1,
  250        lmcache:current_main_error_stream/1,
  251        dbgsubst/4,
  252        dbgsubst0/4,
  253        ddmsg/1,
  254        ddmsg/2,
  255        det_lm/2,
  256        dif_safe/2,
  257        errx/0,
  258        format_to_error/2,
  259        fresh_line_to_err/0,
  260        functor_catch/3,
  261        functor_safe/3,
  262        with_current_why/2,
  263        ib_multi_transparent33/1,
  264        input_key/1,
  265        is_ftCompound/1,
  266        not_ftCompound/1,
  267        is_ftNameArity/2,
  268        is_ftNonvar/1,
  269        is_ftVar/1,
  270        is_main_thread/0,
  271        is_pdt_like/0,
  272        is_release/0,
  273        keep/2,
  274        loading_file/1,
  275        %on_x_log_throwEach/1,
  276        maplist_safe/2,
  277        maplist_safe/3,
  278        module_functor/4,
  279
  280        nd_dbgsubst/4,
  281        nd_dbgsubst1/5,
  282        nd_dbgsubst2/4,
  283        not_is_release/0,
  284        save_streams/0,
  285        save_streams/1,
  286        set_block_exit/2,
  287        showHiddens/0,
  288        show_new_src_location/1,
  289        show_new_src_location/2,
  290
  291            on_xf_log_cont/1,
  292            on_xf_log_cont_l/1,
  293            skip_failx_u/1,
  294            p_call/2,
  295
  296        show_source_location/0,
  297        skipWrapper/0,
  298        skipWrapper0/0,
  299        strip_arity/3,
  300        strip_f_module/2,
  301        get_thread_current_error/1,
  302        throwNoLib/0,
  303        to_m_f_arity_pi/5,
  304        to_pi0/3,
  305        warn_bad_functor/1.  306
  307:- meta_predicate
  308   doall_and_fail(0),
  309   quietly_must(0).  310
  311:- set_module(class(library)).

logicmoo_util_catch - catch-like bocks

Tracer modes:

quietly/1 - turn off tracer if already on but still dtrace on failure must/1 - dtrace on failure rtrace/1 - non interactive debug sanity/1 - run in quietly/1 when problems were detected previously otherwise skippable slow_sanity/1+hide_trace/1 assertion/1 - throw on failure hide_trace/1 - hide dtrace temporarily slow_sanity/1 - skip unless in developer mode

*/

  328:- thread_local( tlbugger:old_no_repeats/0).  329:- thread_local( tlbugger:skip_bugger/0).  330:- thread_local( tlbugger:dont_skip_bugger/0).  331
  332:-meta_predicate(skip_failx_u(*)).  333skip_failx_u(G):- must_det_l(G).
  334% skip_failx_u(G):-call_each([baseKB:call_u,on_xf_log_cont,notrace],G).
  335
  336
  337
  338%=
 is_pdt_like is semidet
If Is A Pdt Like.
  344is_pdt_like:-thread_property(_,alias(pdt_console_server)).
  345is_pdt_like:-lmcache:thread_main(user,Goal),!,Goal \= main.
  346
  347
  348%=
 is_main_thread is semidet
If Is A Main Thread.
  354is_main_thread:-lmcache:thread_main(user,Goal),!,thread_self(Goal).
  355is_main_thread:-thread_self_main,!.
  356
  357:- thread_local(tlbugger:no_colors/0).  358:- thread_local(t_l:thread_local_error_stream/1).  359:- volatile(t_l:thread_local_error_stream/1).  360
  361:- is_pdt_like-> assert(tlbugger:no_colors); true.  362
  363
  364% = :- meta_predicate(with_main_error_to_output(0)).
  365
  366%=
 with_main_error_to_output(:Goal) is semidet
Using Main Error Converted To Output.
  372with_main_error_to_output(Goal):-
  373 current_output(Out),
  374  locally_tl(thread_local_error_stream(Out),Goal).
  375
  376
  377with_current_io(Goal):-
  378  current_input(IN),current_output(OUT),get_thread_current_error(Err),
  379  scce_orig(set_prolog_IO(IN,OUT,Err),Goal,set_prolog_IO(IN,OUT,Err)).
  380
  381
  382
  383with_dmsg_to_main(Goal):-
  384  get_main_error_stream(Err),
  385   locally_tl(thread_local_error_stream(Err),Goal).
  386
  387with_error_to_main(Goal):-
  388  get_main_error_stream(Err),current_error_stream(ErrWas),Err==ErrWas,!,Goal.
  389with_error_to_main(Goal):- 
  390  get_main_error_stream(Err),current_error_stream(ErrWas),
  391   locally_tl(thread_local_error_stream(Err),
  392   scce_orig(set_stream(Err,alias(user_error)),Goal,set_stream(ErrWas,alias(user_error)))).
 set_thread_current_error(Id, ?Err) is det
Thread Current Error Stream.
  402set_thread_error_stream(Id,Err):-
  403   ( \+ atom(Err)->asserta_new(lmcache:thread_current_error_stream(Id,Err));true),
  404   (thread_self(Id)->asserta(t_l:thread_local_error_stream(Err));true).
 get_thread_current_error(?Err) is det
Thread Current Error Stream.
  411get_thread_current_error(Err):- t_l:thread_local_error_stream(Err),!.
  412get_thread_current_error(Err):- thread_self(ID),lmcache:thread_current_error_stream(ID,Err),!.
  413get_thread_current_error(Err):- !,Err=user_error.
  414get_thread_current_error(Err):- stream_property(user_error,file_no(F)),\+ stream_property(main_error,file_no(F)),!,Err=user_error.
  415get_thread_current_error(Err):- get_thread_current_error0(Err),!.
  416get_thread_current_error(Err):- get_main_error_stream(Err),!.
  417
  418get_thread_current_error0(Err):- get_thread_user_error1(Err),stream_property(Err,file_no(FileNo)),FileNo>2,!.
  419get_thread_current_error0(Err):- get_thread_user_error1(Err),!.
  420
  421get_thread_user_error1(Err):- get_thread_user_error2(user_error,Err).
  422% get_thread_user_error1(Err):- get_thread_user_error2(Err,Err).
  423get_thread_user_error1(Err):- get_thread_user_error2(current_error,Err).
  424
  425get_thread_user_error2(ErrName,Err):- nonvar(ErrName),
  426   stream_property(ErrName,file_no(FileNo)),
  427   stream_property(ErrName,output),FileNo\==2,
  428   current_output(Out),stream_property(Out,file_no(FileNo)),
  429   stream_property(Err,file_no(FileNo)),\+ current_input(Err).
  430get_thread_user_error2(ErrName,Err):-
  431   current_output(Out),stream_property(Out,file_no(FileNo)),
  432   stream_property(Err,file_no(FileNo)),
  433   stream_property(Err,output),FileNo\==2,
  434   ignore((stream_property(Err,alias(ErrName)))),ignore((Err=ErrName)).
  435get_thread_user_error2(ErrName,Err):- nonvar(ErrName), stream_property(Err,alias(ErrName)),stream_property(Err,output),!.
 get_main_error_stream(?Err) is det
Current Main Error Stream.
  443get_main_error_stream(Err):- stream_property(Err,alias(main_error)),!.
  444get_main_error_stream(Err):- lmcache:thread_main(user,ID),lmcache:thread_current_error_stream(ID,Err),!.
  445get_main_error_stream(Err):- stream_property(Err,file_no(2)),!.
  446get_main_error_stream(Err):- stream_property(Err,alias(user_error)),!.
  447get_main_error_stream(Err):- thread_call_blocking_one(main,get_thread_current_error(Err)).
  448
  449thread_call_blocking_one(Thread,G):- thread_self(Self),
  450  thread_signal(Thread,
  451   catch(( (G,deterministic(YN),true) 
  452    -> thread_send_message(Self,thread_call_blocking_one(Thread,G,fail,true))
  453     ; thread_send_message(Self,thread_call_blocking_one(Thread,G,true,YN))),
  454     E,thread_send_message(Self,thread_call_blocking_one(Thread,G,throw(E),true)))),
  455   thread_get_message(thread_call_blocking_one(Thread,G,TF,_R)),!,call(TF).
  456
  457
  458%=
 format_to_error(?F, ?A) is semidet
Format Converted To Error.
  464format_to_error(F,A):-get_thread_current_error(Err),!,format(Err,F,A).
  465
  466%=
 fresh_line_to_err is semidet
Fresh Line Converted To Err.
  472fresh_line_to_err:- zotrace((flush_output_safe,get_thread_current_error(Err),format(Err,'~N',[]),flush_output_safe(Err))).
  473
  474:- dynamic(lmcache:thread_current_input/2).  475:- volatile(lmcache:thread_current_input/2).  476
  477:- dynamic(lmcache:thread_current_error_stream/2).  478:- volatile(lmcache:thread_current_error_stream/2).  479
  480%=
 save_streams is semidet
Save Streams.
  486save_streams:- thread_self(ID),save_streams(ID),!.
  487
  488set_mains:-
  489       stream_property(In, alias(user_input)),set_stream(In,alias(main_input)),
  490       stream_property(Out, alias(user_output)),set_stream(Out,alias(main_output)),
  491       find_main_eror(Err),set_stream(Err,alias(main_error)), set_stream(Err,alias(current_error)),set_stream(Err, alias(user_error)).
  492
  493find_main_eror(Err):-stream_property(Err, alias(user_error)).
  494find_main_eror(Err):-stream_property(Err, alias(main_error)).
  495find_main_eror(Err):-stream_property(Err, alias(current_error)).
  496find_main_eror(user_error).
  497
  498set_main_error:- thread_self_main->set_mains;true.
  499
  500
  501current_error_stream_ucatch(Err):-
  502  stream_property(Err,alias(current_error))-> true;  % when we set it
  503  stream_property(Err,alias(user_error)) -> true;
  504  stream_property(Err,file_no(2)).
  505
  506
  507%=
 save_streams(?ID) is semidet
Save Streams.
  513save_streams(ID):-
  514  retractall((lmcache:thread_current_input(ID,_))),
  515  retractall((lmcache:thread_current_error_stream(ID,_))),
  516  current_input(In),asserta(lmcache:thread_current_input(ID,In)),
  517  thread_at_exit(retractall((lmcache:thread_current_input(ID,_)))),
  518  thread_at_exit(retractall((lmcache:thread_current_error_stream(ID,_)))),
  519  (stream_property(Err, alias(user_error));current_error_stream_ucatch(Err)),
  520              asserta(lmcache:thread_current_error_stream(ID,Err)).
  521
  522
  523:- meta_predicate(with_main_input(0)).
 with_main_input(:Goal) is semidet
Using Main Input.
  529with_main_input(Goal):-
  530    current_output(OutPrev),current_input(InPrev),stream_property(ErrPrev,alias(user_error)),
  531    lmcache:thread_main(user,ID),lmcache:thread_current_input(ID,In),lmcache:thread_current_error_stream(ID,Err),
  532    scce_orig(set_prolog_IO(In,OutPrev,Err),Goal,set_prolog_IO(InPrev,OutPrev,ErrPrev)).
  533
  534
  535%=
 with_main_io(:Goal) is semidet
Using Main Input/output.
  541 with_main_io(Goal):-
  542    current_output(OutPrev),
  543    current_input(InPrev),
  544    stream_property(ErrPrev,alias(user_error)),
  545    lmcache:thread_main(user,ID),
  546     lmcache:thread_current_input(ID,In),
  547       lmcache:thread_current_error_stream(ID,Err),
  548    scce_orig(set_prolog_IO(In,Err,Err),Goal,set_prolog_IO(InPrev,OutPrev,ErrPrev)).
  549
  550
  551% bugger_debug=never turns off just debugging about the debugger
  552% dmsg_level=never turns off all the rest of debugging
  553% ddmsg(_):-current_prolog_flag(bugger_debug,false),!.
  554% ddmsg(D):- current_predicate(_:wdmsg/1),wdmsg(D),!.
  555
  556%=
 ddmsg(?D) is semidet
Ddmsg.
  562ddmsg(D):- ddmsg("~N~q~n",[D]).
  563%ddmsg(F,A):- current_predicate(_:wdmsg/2),wdmsg(F,A),!.
  564
  565%=
 ddmsg(?F, ?A) is semidet
Ddmsg.
  571ddmsg(F,A):- format_to_error(F,A),!.
  572
  573%=
 ddmsg_call(:GoalD) is semidet
Ddmsg Call.
  579ddmsg_call(D):- ( (ddmsg(ddmsg_call(D)),call(D),ddmsg(ddmsg_exit(D))) *-> true ; ddmsg(ddmsg_failed(D))).
 doall_and_fail(:Goal) is semidet
Doall And Fail.
  587doall_and_fail(Call):- time_call(once(doall(Call))),fail.
  588
  589quietly_must(G):- /*quietly*/(must(G)).
  590
  591
  592:- module_transparent((if_defined/1,if_defined/2)).
 if_defined(?G) is semidet
If Defined.
  598if_defined(Goal):- if_defined(Goal,((dmsg(warn_undefined(Goal))),!,fail)).
 if_defined(?Goal, :GoalElse) is semidet
If Defined Else.
  604if_defined(Goal,Else):- current_predicate(_,Goal)*->Goal;Else.
  605% if_defined(M:Goal,Else):- !, current_predicate(_,OM:Goal),!,OM:Goal;Else.
  606%if_defined(Goal,  Else):- current_predicate(_,OM:Goal)->OM:Goal;Else.
  607
  608
  609
  610
  611
  612:- meta_predicate when_defined(:).  613:- export(when_defined/1).  614
  615%=
 when_defined(?Goal) is semidet
When Defined.
  621when_defined(Goal):-if_defined(Goal,true).
  622
  623:- if(current_predicate(run_sanity_tests/0)).  624:- listing(lmcache:thread_current_error_stream/2).  625:- endif.  626
  627% = :- meta_predicate(to_mpi_matcher(?,?)).
  628
  629%=
 to_mpi_matcher(?P, ?M) is semidet
Converted To Predicate Indicator.
  635context_modulez(M):-nonvar(M),!.
  636context_modulez(V):-context_module(M),visible_import_module(M,V).
  637
  638visible_import_module(M,V):- M == any,!,current_module(V).
  639visible_import_module(M,V):- M == exact,!,context_module(V).
  640visible_import_module(M,V):- M == direct,!,context_module(C),import_module(C,V).
  641visible_import_module(M,V):- M == inherit,!,context_module(C),default_module(C,V).
  642visible_import_module(M,V):- M == V,!.
  643%visible_import_module(_,V):- V == baseKB.
  644visible_import_module(M,V):- \+ atom(M),!,V=M.
  645visible_import_module(M,V):- import_module(M,V).
  646visible_import_module(M,V):- default_module(M,V), M\==V, \+ import_module(M,V).
  647
  648
  649to_mpi_matcher(P,Matcher):-var(P),!,context_modulez(M),to_mpi_matcher(M:P,Matcher).
  650to_mpi_matcher(Name/Arity, Matcher) :- atom(Name),integer(Arity),functor(Head, Name, Arity),!,
  651 to_mpi_matcher(Head,Matcher).
  652to_mpi_matcher(M:P,M:P):- var(M),!,to_mpi_matcher(P,M:P).
  653%to_mpi_matcher(M:P,MP):- var(P),!,to_mpi_matcher(M:P,MP).
  654
  655to_mpi_matcher(CFind,WPI):- 
  656 strip_module(CFind,SC,Find),
  657 (CFind==Find -> C = any ; C = SC),
  658 locally(set_prolog_flag(runtime_debug,0),
  659   ((once(catch(match_predicates(CFind,Found),_,fail)),Found=[_|_],
  660    findall(WPI,
  661    ((member(M:F/A,Found),
  662      functor(PI,F,A),
  663     (predicate_property(M:PI,imported_from(W)) -> true ; W=M),
  664      visible_import_module(C,W),
  665      WPI = W:PI, 
  666      \+ predicate_property(WPI,imported_from(_)))),
  667     Remaining)))),
  668     Remaining=[_|_],!,
  669     sort(Remaining,Set),     
  670     member(WPI,Set).
  671     
  672
  673%to_mpi_matcher(M:Find,MPI):-context_modulez(M),to_pi0(M,Find,MPI).
  674%to_mpi_matcher(M:PI, Head) :- !, to_mpi_matcher(PI, Head).
  675%to_mpi_matcher(Find,M:PI):-context_modulez(M),to_pi0(M,Find,M:PI).
  676
  677to_pi0(M,Find,M:PI):- atom(Find),!,when(nonvar(PI),(nonvar(PI),functor(PI,Find,_))).
  678to_pi0(M,Find/A,M:PI):-var(Find),number(A),!,when(nonvar(PI),(nonvar(PI),functor(PI,_,A))).
  679to_pi0(M,Find,PI):-get_pi(Find,PI0),!,(PI0\=(_:_)->(context_modulez(M),PI=(M:PI0));PI=PI0).
  680
  681
  682%=
 to_pi0(?M, :TermFind, :TermPI) is semidet
Converted To Predicate Indicator Primary Helper.
  689:- thread_local(t_l:last_src_loc/2).  690
  691%=
 input_key(?K) is semidet
Input Key.
  697input_key(K):-thread_self(K).
  698
  699
  700%=
 show_new_src_location(?FL) is semidet
Show New Src Location.
  706show_new_src_location(FL):-input_key(K),show_new_src_location(K,FL).
  707
  708
  709%=
 show_new_src_location(?K, ?FL) is semidet
Show New Src Location.
  715show_new_src_location(_,F:_):-F==user_input,!.
  716show_new_src_location(K,FL):- t_l:last_src_loc(K,FL),!.
  717show_new_src_location(K,FL):- retractall(t_l:last_src_loc(K,_)),format_to_error('~N% ~w ',[FL]),!,asserta(t_l:last_src_loc(K,FL)).
  718
  719
  720:- thread_local(t_l:current_why_source/1).  721
  722
  723%=
 sl_to_filename(?W, ?W) is semidet
Sl Converted To Filename.
  729sl_to_filename(W,W):-atom(W),exists_file(W),!.
  730sl_to_filename(W,W):-atom(W),!.
  731sl_to_filename(mfl(_,F,_),F):-atom(F),!.
  732sl_to_filename(_:W,W):-atom(W),!.
  733sl_to_filename(W,W).
  734sl_to_filename(W,To):-nonvar(To),To=(W:_),atom(W),!.
  735
  736
  737
  738                 
  739
  740
  741%=
 current_source_file(-CtxColonLinePos) is semidet
Current Source Location.
  747current_source_file(F:L):- clause(current_source_location0(W,L),Body),notrace(catch(Body,_,fail)),
  748 sl_to_filename(W,F),!.
  749current_source_file(F):- F = unknown.
  750
  751
  752source_ctx(B:L):- must((current_source_file(F:L),file_base_name(F,B))).
  753
  754%=
 current_source_location0(-Ctx, -LinePos) is semidet
Current Source Location Primary Helper.
  760current_source_location0(F,why):- t_l:current_why_source(F).
  761current_source_location0(F,L):- source_location(F,L),!.
  762current_source_location0(F,L):- prolog_load_context(file,F),current_input(S),line_position(S,L),!.
  763current_source_location0(F,L):- prolog_load_context(stream,S),line_or_char_count(S,L),stream_property(S,file(F)),!.
  764current_source_location0(F,L):- loading_file(F),stream_property(S,file_name(F)),line_or_char_count(S,L),!.
  765current_source_location0(F,L):- prolog_load_context(file,F),!,ignore((prolog_load_context(stream,S),!,line_or_char_count(S,L))),!.
  766current_source_location0(F,L):- loading_file(F),L= (-1).
  767current_source_location0(F,L):- current_input(S),stream_property(S,alias(F)),line_or_char_count(S,L).
  768current_source_location0(F,L):- current_filesource(F),ignore((prolog_load_context(stream,S),!,line_or_char_count(S,L))),!.
  769current_source_location0(M,module):- source_module(M),!.
  770current_source_location0(M,typein):- '$current_typein_module'(M).
  771
  772line_or_char_count(S,_):- \+ is_stream(S),!,fail.
  773line_or_char_count(S,L):- line_count(S,L),L\==0,!.
  774line_or_char_count(S,L):- stream_property(S,position(P)),stream_position_data(line_count,P,L),!.
  775line_or_char_count(S,L):- line_position(S,L),L\==1,!.
  776line_or_char_count(S,L):- character_count(S,C),L is -C.
  777
  778:-export(current_why/1).  779:-module_transparent(current_why/1).  780
  781%=
 current_why(?Why) is semidet
Current Generation Of Proof.
  787current_why(Why):- nb_current('$current_why',wp(Why,_)),!.
  788current_why(mfl(M,F,L)):- current_mfl(M,F,L).
  789
  790current_mfl(M,F,L):- current_source_file(F:L),var(L),F= module(M),!.
  791current_mfl(M,F,L):- source_module(M),clause_b(mtHybrid(M)),current_source_file(F:L),!.
  792current_mfl(M,F,L):- clause(defaultAssertMt(M),B),call(B),current_source_file(F:L),!.
Restart and Save the Well-founded Semantic Reason while executing code.
  799with_only_current_why(Why,Prolog):- 
  800  (nb_current('$current_why',WAS);WAS=[])-> 
  801   setup_call_cleanup(b_setval('$current_why',wp(Why,Prolog)),
  802    (call(Prolog),b_setval('$current_why',WAS)),
  803     b_setval('$current_why',WAS)).
Save Well-founded Semantic Reason recursively while executing code.
  809with_current_why(S,Call):-
  810  current_why(UU),
  811  (S=@=UU -> Call;
  812  (((UU=(U,_),S=@=U) -> Call; 
  813  with_only_current_why((S,UU),Call)))).
  814
  815:- thread_initialization(nb_setval('$current_why',[])).  816
  817% source_module(M):-!,M=u.
  818:- export(source_module/1).  819:- module_transparent(source_module/1).  820
  821%=
 source_module(?M) is semidet
Source Module.
  827source_module(M):-nonvar(M),!,source_module(M0),!,(M0=M).
  828source_module(M):- '$current_source_module'(M),!.
  829source_module(M):- '$set_source_module'(M,M),!.
  830source_module(M):- loading_module(M),!.
  831
  832:- thread_local(t_l:last_source_file/1).  833:- export(loading_file/1).  834
  835%=
 loading_file(?FIn) is semidet
Loading File.
  841loading_file(FIn):- (quietly((((source_file0(F) *-> (retractall(t_l:last_source_file(_)),asserta(t_l:last_source_file(F))) ; (fail,t_l:last_source_file(F)))),!,F=FIn))).
  842
  843%=
 source_file0(?F) is semidet
Source File Primary Helper.
  849source_file0(F):-source_location(F,_).
  850source_file0(F):-prolog_load_context(file, F).
  851source_file0(F):-prolog_load_context(source, F).
  852source_file0(F):-seeing(S),is_stream(S),stream_property(S,file_name(F)),exists_file(F).
  853source_file0(F):-prolog_load_context(stream, S),stream_property(S,file_name(F)),exists_file(F).
  854source_file0(F):-findall(E,catch((stream_property( S,mode(read)),stream_property(S,file_name(E)),exists_file(E),
  855  line_count(S,Goal),Goal>0),_,fail),L),last(L,F).
  856
  857
  858:-export(source_variables_l/1).  859
  860%=
 source_variables_l(?AllS) is semidet
Source Variables (list Version).
  866source_variables_l(AllS):-
  867 quietly((
  868  (prolog_load_context(variable_names,Vs1);Vs1=[]),
  869  (get_varname_list(Vs2);Vs2=[]),
  870  quietly(catch((parent_goal('$toplevel':'$execute_goal2'(_, Vs3),_);Vs3=[]),E,(writeq(E),Vs3=[]))),
  871  ignore(Vs3=[]),
  872  append(Vs1,Vs2,Vs12),append(Vs12,Vs3,All),!,list_to_set(All,AllS),
  873  set_varname_list( AllS))).
  874
  875
  876
  877%=
 show_source_location is semidet
Show Source Location.
  886:-export( show_source_location/0).  887show_source_location:- current_prolog_flag(dmsg_level,never),!.
  888%show_source_location:- quietly((tlbugger:no_slow_io)),!.
  889show_source_location:- get_source_location(FL),show_new_src_location(FL),!. 
  890show_source_location:- dumpST,dtrace.
  891
  892show_current_source_location:- get_source_location(FL),format_to_error('~N% ~w ',[FL]). 
  893
  894get_source_location(F:L):- source_location(F,L),!.
  895get_source_location(FL):- current_source_file(FL),sanity(nonvar(FL)),!.
  896get_source_location(get_source_location_unknown).
  897
  898
  899% :- ensure_loaded(hook_database).
  900
  901:-export( as_clause_no_m/3).  902
  903%=
 as_clause_no_m(?MHB, ?H, ?B) is semidet
Converted To Clause No Module.
  909as_clause_no_m( MHB,  H, B):- strip_module(MHB,_M,HB), expand_to_hb( HB,  MH, MB),strip_module(MH,_M2H,H),strip_module(MB,_M2B,B).
  910
  911%=
 as_clause_w_m(?MHB, ?M, ?H, ?B) is semidet
Converted To Clause W Module.
  917as_clause_w_m(MHB, M, H, B):-  as_clause_w_m(MHB, M1H, H, B, M2B), (M1H==user->M2B=M;M1H=M).
  918
  919%=
 as_clause_w_m(?MHB, ?M1H, ?H, ?B, ?M2B) is semidet
Converted To Clause W Module.
  925as_clause_w_m(MHB, M1H, H, B, M2B):-  expand_to_hb( MHB,  MH, MB),strip_module(MH,M1H,H),strip_module(MB,M2B,B).
  926
  927:- export(is_ftCompound/1).
 is_ftNameArity(+F, +A) is semidet
If Is A Format Type of a Compound specifier
  933is_ftNameArity(F,A):-integer(A), atom(F), (F \= (/)),A>=0.
 is_ftCompound(?Goal) is semidet
If Is A Format Type Compound.
  939is_ftCompound(Goal):-compound(Goal),\+ is_ftVar(Goal).
 not_ftCompound(?InOut) is semidet
Not Compound.
  945not_ftCompound(A):- \+ is_ftCompound(A).
  946
  947:- export(is_ftVar/1).
 is_ftVar(:TermV) is semidet
If Is A Format Type Variable.
  953is_ftVar(V):- zotrace(is_ftVar0(V)).
  954is_ftVar0(V):- \+ compound(V),!,var(V).
  955is_ftVar0('$VAR'(_)).
  956is_ftVar0('avar'(_,_)).
  957%:- mpred_trace_nochilds(is_ftVar/1).
  958
  959ftVar(X):- is_ftVar(X).
  960ftCompound(X):- is_ftCompound(X).
  961ftNonvar(X):- is_ftNonvar(X).
  962
  963:- export(is_ftNonvar/1).  964
  965%=
 is_ftNonvar(?V) is semidet
If Is A Format Type Nonvar.
  971is_ftNonvar(V):- \+ is_ftVar(V).
  972
  973
  974%================================================================
  975% maplist/[2,3]
  976% this must succeed  maplist_safe(=,[Goal,Goal,Goal],[1,2,3]).
  977% well if its not "maplist" what shall we call it?
  978%================================================================
  979% so far only the findall version works .. the other runs out of local stack!?
  980
  981:- export((   maplist_safe/2,
  982   maplist_safe/3)).  983
  984
  985%=
 maplist_safe(?Pred, ?LIST) is semidet
Maplist Safely Paying Attention To Corner Cases.
  991maplist_safe(_Pred,[]):-!.
  992maplist_safe(Pred,LIST):-findall(E,(member(E,LIST), on_f_debug(apply(Pred,[E]))),LISTO),!, ignore(LIST=LISTO),!.
  993% though this should been fine %  maplist_safe(Pred,[A|B]):- copy_term(Pred+A, Pred0+A0), on_f_debug(once(call(Pred0,A0))),     maplist_safe(Pred,B),!.
  994
  995
  996%=
 maplist_safe(?Pred, ?LISTIN, ?LIST) is semidet
Maplist Safely Paying Attention To Corner Cases.
 1002maplist_safe(_Pred,[],[]):-!.
 1003maplist_safe(Pred,LISTIN, LIST):-!, findall(EE, ((member(E,LISTIN),on_f_debug(apply(Pred,[E,EE])))), LISTO),  ignore(LIST=LISTO),!.
 1004% though this should been fine % maplist_safe(Pred,[A|B],OUT):- copy_term(Pred+A, Pred0+A0), debugOnFailureEach(once(call(Pred0,A0,AA))),  maplist_safe(Pred,B,BB), !, ignore(OUT=[AA|BB]).
 1005
 1006
 1007
 1008:- export(bad_functor/1). 1009
 1010%=
 bad_functor(?L) is semidet
Bad Functor.
 1016bad_functor(L) :- arg(_,v('|',[],':','/'),L). % .
 1017
 1018:- export(warn_bad_functor/1). 1019
 1020%=
 warn_bad_functor(?L) is semidet
Warn Bad Functor.
 1026warn_bad_functor(L):-ignore((zotrace(bad_functor(L)),!,dtrace,call(ddmsg(bad_functor(L))),break)).
 1027
 1028:- export(strip_f_module/2). 1029
 1030%=
 strip_f_module(?P, ?PA) is semidet
Strip Functor Module.
 1036strip_f_module(_:P,FA):-nonvar(P),!,strip_f_module(P,F),!,F=FA.
 1037strip_f_module(P,PA):-atom(P),!,P=PA.
 1038
 1039strip_f_module(P,FA):- is_list(P),catch(text_to_string(P,S),_,fail),!,maybe_notrace(atom_string(F,S)),!,F=FA.
 1040strip_f_module(P,FA):- quietly(string(P);atomic(P)), maybe_notrace(atom_string(F,P)),!,F=FA.
 1041strip_f_module(P,P).
 1042
 1043% use catchv/3 to replace catch/3 works around SWI specific issues arround using $abort/0 and block/3
 1044% (catch/3 allows you to have these exceptions bubble up past your catch block handlers)
 1045% = :- meta_predicate((catchv(0, ?, 0))).
 1046% = :- meta_predicate((catchv(0, ?, 0))).
 1047:- export((catchv/3)).
 catchv(:Goal, ?E, :GoalRecovery) is nondet
Like catch/3 but rethrows block/2 and $abort/0.
 1054catchv(Goal,E,Recovery):- 
 1055   nonvar(E) 
 1056   -> catch(Goal,E,Recovery); % normal mode (the user knows what they want)
 1057   catch(Goal,E,(rethrow_bubbled(E),Recovery)). % prevents promiscous mode
 1058
 1059:-export(catchv/3). 1060:-system:import(catchv/3).
 bubbled_ex(?Ex) is det
Bubbled Exception.
 1067bubbled_ex('$aborted').
 1068bubbled_ex('time_limit_exceeded').
 1069bubbled_ex('$time_limit_exceeded').
 1070bubbled_ex(block(_,_)).
 rethrow_bubbled(?E) is det
Bubbled Exception Check.
 1077rethrow_bubbled(E):- ( \+ bubbled_ex(E)),!.
 1078rethrow_bubbled(E):-throw(E).
 1079
 1080
 1081
 1082:- export(functor_catch/3). 1083
 1084%=
 functor_catch(?P, ?F, ?A) is semidet
Functor Catch.
 1090functor_catch(P,F,A):- catchv(functor(P,F,A),_,compound_name_arity(P,F,A)).
 1091% functor_catch(F,F,0):-atomic(F),!.
 1092% functor_catch(P,F,A):-catchv(compound_name_arity(P,F,A),E,(ddmsg(E:functor(P,F,A)),dtrace)).
 1093
 1094
 1095:- export(functor_safe/3). 1096
 1097%=
 functor_safe(?P, ?F, ?A) is semidet
Functor Safely Paying Attention To Corner Cases.
 1103functor_safe(P,F,A):- (compound(P)->compound_name_arity(P,F,A);functor(P,F,A)),sanity(warn_bad_functor(F)).
 1104% functor_safe(P,F,A):- catchv(functor(P,F,A),_,compound_name_arity(P,F,A)).
 1105% functor_safe(P,F,A):- catchv(compound_name_arity(P,F,A),_,functor(P,F,A)).
 1106/*
 1107% functor_safe(P,F,A):-var(P),A==0,compound_name_arguments(P,F,[]),!.
 1108functor_safe(P,F,A):-var(P),A==0,!,P=F,!.
 1109functor_safe(P,F,A):-functor_safe0(P,F,A),!.
 1110functor_safe0(M:P,M:F,A):-var(P),atom(M),functor_catch(P,F,A),!,warn_bad_functor(F).
 1111functor_safe0(P,F,A):-var(P),strip_f_module(F,F0),functor_catch(P,F0,A),!,warn_bad_functor(F).
 1112functor_safe0(P,F,0):- quietly(string(P);atomic(P)), maybe_notrace(atom_string(F,P)),warn_bad_functor(F).
 1113functor_safe_compound((_,_),',',2).
 1114functor_safe_compound([_|_],'.',2).
 1115functor_safe_compound(_:P,F,A):- functor_catch(P,F,A),!.
 1116functor_safe_compound(P,F,A):- functor_catch(P,F,A).
 1117functor_safe_compound(P,F,A):- var(F),strip_f_module(P,P0),!,functor_catch(P0,F0,A),strip_f_module(F0,F),!.
 1118functor_safe_compound(P,F,A):- strip_f_module(P,P0),strip_f_module(F,F0),!,functor_catch(P0,F0,A).
 1119*/
 1120
 1121% block3(test, (repeat, !(test), fail))).
 1122:- meta_predicate block3(+, :, ?). 1123
 1124%=
 block3(+Name, ?Goal, ?Var) is semidet
Block.
 1130block3(Name, Goal, Var) :- Goal, keep(Name, Var).	% avoid last-call and GC
 1131
 1132%=
 keep(?VALUE1, ?VALUE2) is semidet
Keep.
 1138keep(_, _).
 1139
 1140%=
 set_block_exit(?Name, ?Value) is semidet
Set Block Exit.
 1146set_block_exit(Name, Value) :-  prolog_current_frame(Frame),  prolog_frame_attribute(Frame, parent_goal,  mcall:block3(Name, _, Value)).
 1147
 1148%=
 block(?Name, ?Goal) is semidet
Block.
 1154block(Name, Goal) :-  block3(Name, Goal, Var),  (   Var == !  ->  !  ;   true  ).
 1155
 1156%=
 !(?Name) is semidet
!.
 1162!(Name) :- set_block_exit(Name, !).
 1163
 1164:- export((block3/3,
 1165            set_block_exit/2,
 1166            (block)/2,
 1167            !/1 )). 1168
 1169:- dynamic(buggerFile/1). 1170:- abolish(buggerFile/1),prolog_load_context(source,D),asserta(buggerFile(D)). 1171
 1172
 1173% hasLibrarySupport :- absolute_file_name('logicmoo_util_library.pl',File),exists_file(File).
 1174
 1175
 1176%=
 throwNoLib is semidet
Throw No Lib.
 1182throwNoLib:- dtrace,absolute_file_name('.',Here), buggerFile(BuggerFile), listing(user:library_directory), trace_or_throw(error(existence_error(url, BuggerFile), context(_, status(404, [BuggerFile, from( Here) ])))).
 1183
 1184:- dynamic(buggerDir/1). 1185:- abolish(buggerDir/1),prolog_load_context(directory,D),asserta(buggerDir(D)). 1186
 1187
 1188%=
 addLibraryDir is semidet
Add Library Dir.
 1194addLibraryDir :- buggerDir(Here),atom_concat(Here,'/..',UpOne), absolute_file_name(UpOne,AUpOne),asserta(user:library_directory(AUpOne)).
 1195
 1196% if not has library suport, add this direcotry as a library directory
 1197% :-not(hasLibrarySupport) -> addLibraryDir ; true .
 1198
 1199% :-hasLibrarySupport->true;throwNoLib.
 1200
 1201
 1202
 1203
 1204
 1205%=
 ib_multi_transparent33(?MT) is semidet
Ib Multi Transparent33.
 1211ib_multi_transparent33(MT):-multifile(MT),module_transparent(MT),dynamic_safe(MT).
 1212
 1213
 1214%=
 dif_safe(?Agent, ?Obj) is semidet
Dif Safely Paying Attention To Corner Cases.
 1220dif_safe(Agent,Obj):- (var(Agent);var(Obj)),!.
 1221dif_safe(Agent,Obj):- Agent\==Obj.
 1222
 1223% hide Pred from tracing
 1224
 1225%=
 to_m_f_arity_pi(?Term, ?M, ?F, ?A, ?PI) is semidet
Converted To Module Functor Arity Predicate Indicator.
 1231to_m_f_arity_pi(M:Plain,M,F,A,PI):-!,to_m_f_arity_pi(Plain,M,F,A,PI).
 1232to_m_f_arity_pi(Term,M,F,A,PI):- strip_module(Term,M,Plain),Plain\==Term,!,to_m_f_arity_pi(Plain,M,F,A,PI).
 1233to_m_f_arity_pi(F/A,_M,F,A,PI):-functor_safe(PI,F,A),!.
 1234to_m_f_arity_pi(PI,_M,F,A,PI):-functor_safe(PI,F,A).
 1235
 1236
 1237%=
 with_preds(?H, ?M, ?F, ?A, ?PI, :Goal) is semidet
Using Predicates.
 1243with_preds((H,Y),M,F,A,PI,Goal):-!,with_preds(H,M,F,A,PI,Goal),with_preds(Y,M,F,A,PI,Goal).
 1244with_preds([H],M,F,A,PI,Goal):-!,with_preds(H,M,F,A,PI,Goal).
 1245with_preds([H|Y],M,F,A,PI,Goal):-!,with_preds(H,M,F,A,PI,Goal),with_preds(Y,M,F,A,PI,Goal).
 1246with_preds(M:H,_M,F,A,PI,Goal):-!, with_preds(H,M,F,A,PI,Goal).
 1247with_preds(H,M,F,A,PI,Goal):-forall(to_m_f_arity_pi(H,M,F,A,PI),Goal).
 1248
 1249
 1250
 1251% ===================================================================
 1252% Substitution based on ==
 1253% ===================================================================
 1254% Usage: dbgsubst(+Fml,+Goal,+Sk,?FmlSk)
 1255
 1256:- export(dbgsubst/4). 1257
 1258%=
 dbgsubst(?A, ?B, ?Goal, ?A) is semidet
Dbgsubst.
 1264dbgsubst(A,B,Goal,A):- B==Goal,!.
 1265dbgsubst(A,B,Goal,D):-var(A),!,ddmsg(dbgsubst(A,B,Goal,D)),dumpST,dtrace(dbgsubst0(A,B,Goal,D)).
 1266dbgsubst(A,B,Goal,D):-dbgsubst0(A,B,Goal,D).
 1267
 1268
 1269%=
 dbgsubst0(?A, ?B, ?Goal, ?D) is semidet
Dbgsubst Primary Helper.
 1275dbgsubst0(A,B,Goal,D):-
 1276      catchv(quietly(nd_dbgsubst(A,B,Goal,D)),E,(dumpST,ddmsg(E:nd_dbgsubst(A,B,Goal,D)),fail)),!.
 1277dbgsubst0(A,_B,_C,A).
 1278
 1279
 1280%=
 nd_dbgsubst(?Var, ?VarS, ?SUB, ?SUB) is semidet
Nd Dbgsubst.
 1286nd_dbgsubst(  Var, VarS,SUB,SUB ) :- Var==VarS,!.
 1287nd_dbgsubst(  P, Goal,Sk, P1 ) :- functor_safe(P,_,N),nd_dbgsubst1( Goal, Sk, P, N, P1 ).
 1288
 1289
 1290%=
 nd_dbgsubst1(?Goal, ?Sk, ?P, ?N, ?P1) is semidet
Nd Dbgsubst Secondary Helper.
 1296nd_dbgsubst1( _,  _, P, 0, P  ).
 1297nd_dbgsubst1( Goal, Sk, P, N, P1 ) :- N > 0,univ_safe_2( P, [F|Args]),
 1298            nd_dbgsubst2( Goal, Sk, Args, ArgS ),
 1299            nd_dbgsubst2( Goal, Sk, [F], [FS] ),
 1300            univ_safe_2(P1 , [FS|ArgS]).
 1301
 1302
 1303%=
 nd_dbgsubst2(?X, ?Sk, ?L, ?L) is semidet
Nd Dbgsubst Extended Helper.
 1309nd_dbgsubst2( _,  _, [], [] ).
 1310nd_dbgsubst2( Goal, Sk, [A|As], [Sk|AS] ) :- Goal == A, !, nd_dbgsubst2( Goal, Sk, As, AS).
 1311nd_dbgsubst2( Goal, Sk, [A|As], [A|AS]  ) :- var(A), !, nd_dbgsubst2( Goal, Sk, As, AS).
 1312nd_dbgsubst2( Goal, Sk, [A|As], [Ap|AS] ) :- nd_dbgsubst( A,Goal,Sk,Ap ),nd_dbgsubst2( Goal, Sk, As, AS).
 1313nd_dbgsubst2( _X, _Sk, L, L ).
 1314
 1315
 1316
 1317%=========================================
 1318% Module Utils
 1319%=========================================
 1320
 1321%=
 module_functor(?PredImpl, ?Module, ?Pred, ?Arity) is semidet
Module Functor.
 1327module_functor(PredImpl,Module,Pred,Arity):-strip_module(PredImpl,Module,NewPredImpl),strip_arity(NewPredImpl,Pred,Arity).
 1328
 1329
 1330%=
 strip_arity(?PredImpl, ?Pred, ?Arity) is semidet
Strip Arity.
 1336strip_arity(Pred/Arity,Pred,Arity).
 1337strip_arity(PredImpl,Pred,Arity):-functor_safe(PredImpl,Pred,Arity).
 1338
 1339/*
 1340
 1341debug(+Topic, +Format, +Arguments)
 1342Prints a message using format(Format, Arguments) if Topic unies with a topic
 1343enabled with debug/1.
 1344debug/nodebug(+Topic [>le])
 1345Enables/disables messages for which Topic unies. If >le is added, the debug
 1346messages are appended to the given le.
 1347assertion(:Goal)
 1348Assumes that Goal is true. Prints a stack-dump and traps to the debugger otherwise.
 1349This facility is derived from the assert() macro as used in Goal, renamed
 1350for obvious reasons.
 1351*/
 1352:- meta_predicate with_preds(?,?,?,?,?,0). 1353
 1354
 1355
 1356%set_prolog_flag(N,V):-!,nop(set_prolog_flag(N,V)).
 1357
 1358
 1359% have to load this module here so we dont take ownership of prolog_exception_hook/4.
 1360:- set_prolog_flag(generate_debug_info, true). 1361% have to load this module here so we dont take ownership of prolog_exception_hook/4.
 1362
 1363% :- ensure_loaded(library(backcomp)).
 1364:- ensure_loaded(library(ansi_term)). 1365:- ensure_loaded(library(check)). 1366:- ensure_loaded(library(debug)). 1367:- ensure_loaded(library(lists)). 1368:- ensure_loaded(library(make)). 1369:- ensure_loaded(library(system)). 1370:- ensure_loaded(library(apply)). 1371
 1372:- thread_local(t_l:session_id/1). 1373:- multifile(t_l:session_id/1). 1374
 1375:- thread_local(tlbugger:no_colors/0). 1376
 1377
 1378% =========================================================================
 1379
 1380
 1381%=
 trace_or_throw(?E) is semidet
Trace or throw.
 1387trace_or_throw(E):- hide_non_user_console,quietly((thread_self(Self),wdmsg(thread_trace_or_throw(Self+E)),!,throw(abort),
 1388                    thread_exit(trace_or_throw(E)))).
 1389trace_or_throw(E):- wdmsg(trace_or_throw(E)),trace,break,dtrace((dtrace,throw(E))).
 1390
 1391 %:-interactor.
 1392
 1393
 1394% false = hide this wrapper
 1395
 1396%=
 showHiddens is semidet
Show Hiddens.
 1402showHiddens:-true.
 1403
 1404:- meta_predicate on_x_log_fail(0). 1405:- export(on_x_log_fail/1). 1406
 1407%=
 on_x_log_fail(:Goal) is semidet
If there If Is A an exception in :Goal goal then log fail.
 1413on_x_log_fail(Goal):- catchv(Goal,E,(dmsg(E:Goal),fail)).
 1414
 1415on_xf_log_cont(Goal):- (on_x_log_cont(Goal)*->true;dmsg(on_f_log_cont(Goal))).
 1416
 1417on_xf_log_cont_l(Goal):- call_each(on_xf_log_cont,Goal).
 1418
 1419% -- CODEBLOCK
 1420
 1421:- export(on_x_log_throw/1). 1422:- export(on_x_log_cont/1). 1423
 1424%=
 on_x_log_throw(:Goal) is semidet
If there If Is A an exception in :Goal goal then log throw.
 1430on_x_log_throw(Goal):- catchv(Goal,E,(ddmsg(on_x_log_throw(E,Goal)),throw(E))).
 1431%on_x_log_throwEach(Goal):-with_each(1,on_x_log_throw,Goal).
 1432
 1433%=
 on_x_log_cont(:Goal) is semidet
If there If Is A an exception in :Goal goal then log cont.
 1439on_x_log_cont(Goal):- catchv( (Goal*->true;ddmsg(failed_on_x_log_cont(Goal))),E,ddmsg(E:Goal)).
 1440
 1441:- thread_local( tlbugger:skipMust/0). 1442%MAIN tlbugger:skipMust.
 1443
 1444
 1445:- export(errx/0). 1446
 1447%=
 errx is semidet
Errx.
 1453errx:-on_x_debug((ain(tlbugger:dont_skip_bugger),do_gc,dumpST(10))),!.
 1454
 1455:- thread_local(tlbugger:rtracing/0). 1456
 1457
 1458
 1459/*
 1460
 1461A value 0 means that the corresponding quality is totally unimportant, and 3 that the quality is extremely important; 
 14621 and 2 are intermediate values, with 1 the neutral value. (quality 3) can be abbreviated to quality.
 1463
 1464*/
 1465compute_q_value(N,N):- number(N),!.
 1466compute_q_value(false,0).
 1467compute_q_value(neutral,1).
 1468compute_q_value(true,2).
 1469compute_q_value(quality,3).
 1470compute_q_value(Flag,Value):-current_prolog_flag(Flag,M),!,compute_q_value(M,Value).
 1471compute_q_value(N,1):- atom(N).
 1472compute_q_value(N,V):- V is N.
 1473
 1474/*
 1475
 1476Name                        Meaning
 1477---------------------       --------------------------------
 1478logicmoo_compilation_speed  speed of the compilation process   
 1479
 1480runtime_debug              ease of debugging                  
 1481logicmoo_space              both code size and run-time space  
 1482
 1483runtime_safety             run-time error checking            
 1484runtime_speed              speed of the object code
 1485
 1486unsafe_speedups      speed up that are possibily
 1487
 1488*/
 1489flag_call(FlagHowValue):-zotrace(flag_call0(FlagHowValue)).
 1490flag_call0(Flag = Quality):- compute_q_value(Quality,Value),!, set_prolog_flag(Flag,Value).
 1491flag_call0(FlagHowValue):- univ_safe_2(FlagHowValue,[How,Flag,Value]),
 1492    compute_q_value(Flag,QVal),compute_q_value(Value,VValue),!,call(How,QVal,VValue).
 1493
 1494
 1495
 1496%=
 skipWrapper is semidet
Skip Wrapper.
 1503% false = use this wrapper, true = code is good and avoid using this wrapper
 1504:- export(skipWrapper/0). 1505
 1506% skipWrapper:-!.
 1507skipWrapper:- zotrace((ucatch:skipWrapper0)).
 1508% skipWrapper:- tracing,!.
 1509
 1510skipWrapper0:- current_prolog_flag(bugger,false),!.
 1511skipWrapper0:- tracing, \+ tlbugger:rtracing,!.
 1512skipWrapper0:- tlbugger:dont_skip_bugger,!,fail.
 1513%skipWrapper0:- flag_call(runtime_debug true) ,!,fail.
 1514%skipWrapper0:- current_prolog_flag(unsafe_speedups , true) ,!.
 1515skipWrapper0:- tlbugger:skip_bugger,!.
 1516%skipWrapper0:- is_release,!.
 1517%skipWrapper0:- 1 is random(5),!.
 1518%skipWrapper0:- tlbugger:skipMust,!.
 1519
 1520:- '$hide'(skipWrapper/0). 1521
 1522%MAIN tlbugger:skip_bugger.
 1523
 1524
 1525% = :- meta_predicate(one_must(0,0)).
 1526
 1527%=
 one_must(:GoalMCall, :GoalOnFail) is semidet
One Must Be Successfull.
 1533one_must(MCall,OnFail):-  call(MCall) *->  true ; call(OnFail).
 1534
 1535
 1536
 1537%=
 must_det_u(:Goal) is semidet
Must Be Successfull Deterministic.
 1544%must_det_u(Goal):- !,maybe_notrace(Goal),!.
 1545must_det_u(Goal):- must(Goal),!.
 1546%must_det_u(Goal):- Goal->true;ignore(rtrace(Goal)).
 1547
 1548
 1549%=
 one_must_det(:Goal, :GoalOnFail) is semidet
One Must Be Successfull Deterministic.
 1555one_must_det(Goal,_OnFail):-Goal,!.
 1556one_must_det(_Call,OnFail):-OnFail,!.
 1557
 1558
 1559%=
 must_det_dead(:Goal, :GoalOnFail) is semidet
Must Be Successfull Deterministic.

must_det_dead(Goal,OnFail):- trace_or_throw(deprecated(must_det_u(Goal,OnFail))),Goal,!. must_det_dead(_Call,OnFail):-OnFail.

 1568:- module_transparent(must_det_l/1). 1569
 1570%=
 must_det_l(:GoalMGoal) is semidet
Must Be Successfull Deterministic (list Version).
 1576must_det_l(Goal):- call_each(must_det_u,Goal).
 1577
 1578must_det_l_pred(Pred,Rest):- tlbugger:skip_bugger,!,call(Pred,Rest).
 1579must_det_l_pred(Pred,Rest):- call_each(call_must_det(Pred),Rest).
 1580
 1581call_must_det(Pred,Arg):- must_det_u(call(Pred,Arg)),!.
 1582
 1583is_call_var(Goal):- strip_module(Goal,_,P),var(P).
 1584
 1585call_each(Pred,Goal):- (is_call_var(Pred);is_call_var(Goal)),!,trace_or_throw(var_call_each(Pred,Goal)),!.
 1586call_each(Pred,[Goal]):- !, dmsg(trace_syntax(call_each(Pred,[Goal]))),!,call_each(Pred,Goal).
 1587call_each(Pred,[Goal|List]):- !, dmsg(trace_syntax(call_each(Pred,[Goal|List]))), !, call_each(Pred,Goal),!,call_each(Pred,List).
 1588% call_each(Pred,Goal):-tlbugger:skip_bugger,!,p_call(Pred,Goal).
 1589call_each(Pred,M:(Goal,List)):-!, call_each(Pred,M:Goal),!,call_each(Pred,M:List).
 1590call_each(Pred,(Goal,List)):- !, call_each(Pred,Goal),!,call_each(Pred,List).
 1591call_each(Pred,Goal):- p_call(Pred,Goal),!.
 1592
 1593% p_call(Pred,_:M:Goal):-!,p_call(Pred,M:Goal).
 1594p_call([Pred1|PredS],Goal):-!,p_call(Pred1,Goal),p_call(PredS,Goal).
 1595p_call((Pred1,PredS),Goal):-!,p_call(Pred1,Goal),p_call(PredS,Goal).
 1596p_call((Pred1;PredS),Goal):-!,p_call(Pred1,Goal);p_call(PredS,Goal).
 1597p_call(Pred,Goal):-call(Pred,Goal).
 1598
 1599must_find_and_call(G):-must(G).
 1600
 1601:- module_transparent(det_lm/2). 1602
 1603%=
 det_lm(?M, ?Goal) is semidet
Deterministic Lm.
 1609det_lm(M,(Goal,List)):- !,Goal,!,det_lm(M,List).
 1610det_lm(M,Goal):-M:Goal,!.
 1611
 1612:- module_transparent(must_l/1). 1613
 1614%=
 must_l(:Goal) is semidet
Must Be Successfull (list Version).
 1620must_l(Goal):- skipWrapper,!,call(Goal).
 1621must_l(Goal):- var(Goal),trace_or_throw(var_must_l(Goal)),!.
 1622must_l((A,!,B)):-!,must(A),!,must_l(B).
 1623must_l((A,B)):-!,must((A,deterministic(Det),true,(Det==true->(!,must_l(B));B))).
 1624must_l(Goal):- must(Goal).
 1625
 1626
 1627:- thread_local tlbugger:skip_use_slow_sanity/0. 1628:- asserta((tlbugger:skip_use_slow_sanity:-!)). 1629
 1630% thread locals should defaults to false  tlbugger:skip_use_slow_sanity.
 1631
 1632
 1633%=
 slow_sanity(:Goal) is semidet
Slow Optional Sanity Checking.
 1639slow_sanity(Goal):- ( tlbugger:skip_use_slow_sanity ; must(Goal)),!.
 1640
 1641
 1642:- meta_predicate(hide_trace(0)). 1643
 1644hide_trace(G):- \+ tracing,!,call(G).
 1645hide_trace(G):- !,call(G).
 1646hide_trace(G):- skipWrapper,!,call(G).
 1647hide_trace(G):-
 1648 restore_trace((
 1649   quietly(
 1650      ignore((tracing,
 1651      visible(-all),
 1652      visible(-unify),
 1653      visible(+exception),
 1654      maybe_leash(-all),
 1655      maybe_leash(+exception)))),G)).
 1656
 1657:- meta_predicate(on_x_f(0,0,0)). 1658on_x_f(G,X,F):-catchv(G,E,(dumpST,wdmsg(E),X)) *-> true ; F .
 1659
 1660% :- meta_predicate quietly(0).
 1661
 1662% quietly(G):- skipWrapper,!,call(G).
 1663% quietly(G):- !,quietly(G).
 1664% quietly(G):- !, on_x_f((G),setup_call_cleanup(wdmsg(begin_eRRor_in(G)),rtrace(G),wdmsg(end_eRRor_in(G))),fail).
 1665/*quietly(G):- on_x_f(hide_trace(G),
 1666                     setup_call_cleanup(wdmsg(begin_eRRor_in(G)),rtrace(G),wdmsg(end_eRRor_in(G))),
 1667                     fail).
 1668*/
 1669
 1670:- if(current_prolog_flag(optimise,true)). 1671is_recompile:-fail.
 1672:- else. 1673is_recompile:-fail.
 1674:- endif. 1675
 1676% -- CODEBLOCK
 1677% :- export(7sanity/1).
 1678% = :- meta_predicate(sanity(0)).
 1679
 1680
 1681
 1682compare_results(N+NVs,O+OVs):-
 1683   NVs=@=OVs -> true; trace_or_throw(compare_results(N,O)).
 1684
 1685allow_unsafe_code :- fail.
 1686
 1687unsafe_safe(_,O):- \+ allow_unsafe_code, !, call(O).
 1688unsafe_safe(N,O):- on_diff_throw(N,O).
 1689
 1690:- export(need_speed/0). 1691need_speed:-current_prolog_flag(unsafe_speedups , true) .
 1692
 1693:- export(is_release/0).
 is_release is semidet
If Is A Release.
 1698is_release:- current_prolog_flag(unsafe_speedups, false) ,!,fail.
 1699is_release:- !,fail.
 1700is_release:- current_prolog_flag(unsafe_speedups , true) ,!.
 1701is_release:- zotrace((\+ flag_call(runtime_debug == true) , \+ (1 is random(4)))).
 not_is_release is semidet
Not If Is A Release.
 1709:- export(not_is_release/0). 1710not_is_release:- \+ is_release.
 1711
 1712
 1713
 1714:- thread_local tlbugger:show_must_go_on/0. 1715
 1716%=
 badfood(?MCall) is semidet
Badfood.
 1722badfood(MCall):- numbervars(MCall,0,_,[functor_name('VAR_______________________x0BADF00D'),attvar(bind),singletons(false)]),dumpST.
 1723
 1724% -- CODEBLOCK
 1725:- export(without_must/1). 1726% = :- meta_predicate(without_must(0)).
 1727
 1728
 1729%=
 without_must(:Goal) is semidet
Without Must Be Successfull.
 1735without_must(Goal):- locally(tlbugger:skipMust,Goal).
 1736
 1737% -- CODEBLOCK
 1738:- export(y_must/2). 1739:- meta_predicate (y_must(?,0)). 1740
 1741%=
 y_must(?Y, :Goal) is semidet
Y Must Be Successfull.
 1747y_must(Y,Goal):- catchv(Goal,E,(wdmsg(E:must_xI__xI__xI__xI__xI_(Y,Goal)),fail)) *-> true ; dtrace(y_must(Y,Goal)).
 1748
 1749% -- CODEBLOCK
 1750% :- export(must/1).
 1751%:- meta_predicate(must(0)).
 1752%:- meta_predicate(must(0)).
 1753
 1754%=
 1755
 1756
 1757dumpST_error(Msg):- zotrace((ddmsg(error,Msg),dumpST,wdmsg(error,Msg))).
 1758
 1759
 1760:- thread_self_main->true;writeln(user_error,not_thread_self_main_consulting_ucatch). 1761:- save_streams. 1762:- initialization(save_streams,now). 1763:- initialization(save_streams,after_load). 1764:- initialization(save_streams,restore). 1765:- thread_initialization(save_streams). 1766
 1767
 1768:- setup_call_cleanup(true,set_main_error,notrace). 1769:- initialization(set_main_error). 1770:- initialization(set_main_error,after_load). 1771:- initialization(set_main_error,restore). 1772:- notrace. 1773
 1774%:- 'mpred_trace_none'(ddmsg(_)).
 1775%:- 'mpred_trace_none'(ddmsg(_,_)).
 1776
 1777
 1778sanity2(_Loc,Goal):- sanity(Goal).
 1779must2(_Loc,Goal):- must(Goal).
 1780
 1781ge_expand_goal(G,G):- \+ compound(G),!,fail.
 1782ge_expand_goal(G,GO):- expand_goal(G,GO).
 1783
 1784% ge_must_sanity(sanity(_),true).
 1785% ge_must_sanity(must(Goal),GoalO):-ge_expand_goal(Goal,GoalO).
 1786% ge_must_sanity(find_and_call(Goal),GoalO):-ge_expand_goal(Goal,GoalO).
 1787
 1788% ge_must_sanity(sanity(Goal),nop(sanity(GoalO))):- ge_expand_goal(Goal,GoalO).
 1789% ge_must_sanity(must(Goal),(GoalO*->true;debugCallWhy(failed_must(Goal,FL),GoalO))):- source_ctx(FL),ge_expand_goal(Goal,GoalO).
 1790
 1791ge_must_sanity(P,O):- univ_safe_2(P,[F,Arg]),nonvar(Arg),ge_must_sanity(F,Arg,O).
 1792
 1793ge_must_sanity(sanity,Goal,sanity2(FL,Goal)):- source_ctx(FL).
 1794ge_must_sanity(must,Goal,must2(FL,Goal)):- source_ctx(FL).
 1795% ge_must_sanity(must_det_l,Goal,must2(FL,Goal)):- source_ctx(FL).
 1796
 1797system:goal_expansion(I,P,O,P):- notrace((compound(I), source_location(_,_))),
 1798  (prolog_load_context(module, Module),default_module(Module,ucatch)),
 1799  once(ge_must_sanity(I,O))->I \== O.
 1800
 1801:- dynamic(inlinedPred/1). 1802
 1803/*
 1804system:goal_expansion(I,O):- fail, compound(I),functor(I,F,A),inlinedPred(F/A),
 1805  source_location(File,L),clause(I,Body),O= (file_line(F,begin,File,L),Body,file_line(F,end,File,L)).
 1806*/
 1807
 1808file_line(F,What,File,L):- (debugging(F)->wdmsg(file_line(F,What,File,L));true).
 1809
 1810
 1811:- ignore((source_location(S,_),prolog_load_context(module,M),module_property(M,class(library)),
 1812 forall(source_file(M:H,S),
 1813 ignore((functor(H,F,A),
 1814  ignore(((\+ atom_concat('$',_,F),(export(F/A) , current_predicate(system:F/A)->true; system:import(M:F/A))))),
 1815  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]))))))))). 1816
 1817% :- set_prolog_flag(compile_meta_arguments,true).