2:- if( \+ current_predicate(cls/0)).    3
    4:- context_module(M),hidden_away:module(hidden_away),
    5   module(M),hidden_away:use_module(library(debuggery/dmsg),[dmsg/1,dmsg/2]).    6
    7%:- use_module(library(programk/cyc_pl/cyc),[is_string/1,isConsole/0,atom_number/2,balanceBinding/2,writeFmtFlushed/2,writeFmtFlushed/3,toCycApiExpression/3]).
    8
    9:- use_module(library(debuggery/ucatch),[catchv/3]).   10:- multifile(dumpst_hook:simple_rewrite/2).   11:- dynamic(dumpst_hook:simple_rewrite/2).   12
   13dumpst_hook:simple_rewrite(I,O):- hide_complex_ctx(I,O).
   14
   15% :-ensure_loaded(('cyc_pl/cyc.pl')).
   16
   17/*
   18:- if( predicate_property(cyc:debugFmt(_), defined)).
   19:- abolish(cyc:debugFmt/1).
   20:- endif.
   21
   22:- if( predicate_property(cyc:debugFmt(_,_), defined)).
   23:- abolish(cyc:debugFmt/2).
   24:- else.
   25:- endif.
   26:- if(\+ predicate_property(nop(_),defined)).
   27:- endif.
   28%:- if(\+ predicate_property(alldiscontiguous(),defined)).
   29%:- endif.
   30
   31*/
   32
   33cls:-shell(cls).
   34
   35:-asserta(user:library_directory('/opt/logicmoo_workspace/packs_sys/logicmoo_utils/prolog/')).   36
   37:- if( \+ predicate_property(term_to_string(_,_),defined)).   38term_to_string(I,IS):- error_catch(string_to_atom(IS,I),_,fail),!.
   39term_to_string(I,IS):- term_to_atom(I,A),string_to_atom(IS,A),!.
   40:- endif.   41
   42:- if( \+ predicate_property(nop(_),defined)).   43nop(_).
   44:- endif.   45
   46
   47
   48%:- module_transparent(setup_call_cleanup/3).
   49
   50% setup_call_cleanup(X,Y,Z):- X,!,call_cleanup(Y,Z).
   51% atomic_list_concat_aiml(X,Y,Z):- atomic_list_concat_aiml(X,Y,Z).
   52
   53
   54
   55:- meta_predicate('$with_unlocked_pred_local'(:,0)).   56'$with_unlocked_pred_local'(MP,Goal):- strip_module(MP,M,P),Pred=M:P,
   57   (predicate_property(Pred,foreign)-> true ;
   58  (
   59 ('$get_predicate_attribute'(Pred, system, OnOff)->true;throw('$get_predicate_attribute'(Pred, system, OnOff))),
   60 (==(OnOff,0) -> Goal ;
   61 setup_call_cleanup('$set_predicate_attribute'(Pred, system, 0),
   62   catch(Goal,E,throw(E)),'$set_predicate_attribute'(Pred, system, 1))))).
   63
   64:- meta_predicate(totally_hide_here(:)).   65totally_hide_here(MP):- strip_module(MP,M,P),Pred=M:P,
   66   % (current_prolog_flag(runtime_debug,N), N>2) -> unhide(Pred) ; 
   67  '$with_unlocked_pred_local'(Pred,
   68   (('$set_predicate_attribute'(Pred, trace, 0),'$set_predicate_attribute'(Pred, hide_childs, 1)))).
   69
   70:-totally_hide(totally_hide/1).   71
   72
   73
   74%:- totally_hide(quietly/1).
 rtrace is det
Start RTracer.
   82rtrace:- start_rtrace,trace.
   83
   84:- 'totally_hide'(rtrace/0).   85
   86start_rtrace:-
   87      leash(-all),
   88      assert(t_l:rtracing),
   89      set_prolog_flag(access_level,system),
   90      push_guitracer,
   91      set_prolog_flag(gui_tracer,false),
   92      visible(+all),
   93      visible(+exception),
   94      maybe_leash(+exception).
   95
   96:- 'totally_hide'(start_rtrace/0).
 srtrace is det
Start RTracer.
  102srtrace:- notrace, set_prolog_flag(access_level,system), rtrace.
  103
  104:- totally_hide(srtrace/0).
 nortrace is det
Stop Tracer.
  112stop_rtrace:- 
  113  notrace,
  114  maybe_leash(+all),
  115  visible(+all),
  116  maybe_leash(+exception),
  117  retractall(t_l:rtracing),
  118  !.
  119
  120:- 'totally_hide'(stop_rtrace/0).  121:- system:import(stop_rtrace/0).  122
  123nortrace:- stop_rtrace,ignore(pop_tracer).
  124
  125:- totally_hide(nortrace/0).  126
  127
  128:- thread_local('$leash_visible'/2).
 restore_trace(:Goal) is det
restore Trace.

! restore_trace( :Goal) is nondet.

restore Trace.

  138restore_trace(Goal):- 
  139  setup_call_cleanup(
  140   push_leash_visible,
  141   scce_orig(push_tracer,Goal,pop_tracer),
  142   restore_leash_visible).
  143
  144restore_trace0(Goal):- 
  145  '$leash'(OldL, OldL),'$visible'(OldV, OldV),
  146   scce_orig(restore_leash_visible,
  147   ((Goal*-> (push_leash_visible, '$leash'(_, OldL),'$visible'(_, OldV)) ; fail)),
  148   ('$leash'(_, OldL),'$visible'(_, OldV))).
  149
  150:- totally_hide(system:'$leash'/2).  151:- totally_hide(system:'$visible'/2).  152
  153push_leash_visible:- notrace((('$leash'(OldL0, OldL0),'$visible'(OldV0, OldV0), asserta('$leash_visible'(OldL0,OldV0))))).
  154restore_leash_visible:- notrace((('$leash_visible'(OldL1,OldV1)->('$leash'(_, OldL1),'$visible'(_, OldV1));true))).
  155
  156% restore_trace(Goal):- setup_call_cleanup(get_trace_reset(Reset),Goal,notrace(Reset)).
  157:- totally_hide(restore_trace/0).
 push_guitracer is nondet
Save Guitracer.
  165push_guitracer:-  notrace(ignore(((current_prolog_flag(gui_tracer, GWas);GWas=false),asserta(t_l:wasguitracer(GWas))))).
  166:- totally_hide(push_guitracer/0).
 pop_guitracer is nondet
Restore Guitracer.
  173pop_guitracer:- notrace(ignore(((retract(t_l:wasguitracer(GWas)),set_prolog_flag(gui_tracer, GWas))))).
  174:- totally_hide(pop_guitracer/0).
 maybe_leash(+Flags) is det
Only leashes interactive consoles
  180maybe_leash(Some):- notrace((maybe_leash->leash(Some);true)).
  181:- totally_hide(maybe_leash/1).  182
  183maybe_leash:- notrace((\+ current_prolog_flag(runtime_must,keep_going), \+ non_user_console)).
  184
  185
  186non_user_console:- !,fail.
  187non_user_console:- \+ stream_property(current_input, tty(true)),!.
  188non_user_console:- \+ stream_property(current_input,close_on_abort(false)).
  189
  190
  191
  192rtrace(Goal):- notrace(tracing)-> rtrace0((trace,Goal)) ; 
  193  setup_call_cleanup(current_prolog_flag(debug,WasDebug),
  194   rtrace0((trace,Goal)),(set_prolog_flag(debug,WasDebug),notrace(stop_rtrace))).
  195rtrace0(Goal):-
  196 setup_call_cleanup(notrace((current_prolog_flag(debug,O),rtrace)),
  197   (trace,Goal,notrace,deterministic(YN),
  198     (YN == true->!;next_rtrace)),
  199     notrace(set_prolog_flag(debug,O))).
  200
  201
  202scce_orig_here(Setup,Goal,Cleanup):-
  203   \+ \+ '$sig_atomic'(Setup), 
  204   catch( 
  205     ((Goal, deterministic(DET)),
  206       '$sig_atomic'(Cleanup),
  207         (DET == true -> !
  208          ; (true;('$sig_atomic'(Setup),fail)))), 
  209      E, 
  210      ('$sig_atomic'(Cleanup),throw(E))). 
  211
  212
  213set_leash_vis(OldL,OldV):- '$leash'(_, OldL),'$visible'(_, OldV),!.
  214:- totally_hide(set_leash_vis/2).  215
  216next_rtrace:- (nortrace;(rtrace,trace,notrace(fail))).
  217:- 'totally_hide'(next_rtrace/0).  218
  219
  220
  221:- '$hide'(rtrace/1).  222:- '$hide'(rtrace0/1).  223:- '$set_predicate_attribute'(rtrace/1, hide_childs, 1).  224:- '$set_predicate_attribute'(rtrace0/1, hide_childs, 0).
 get_trace_reset(?Reset) is det
Get Tracer.
  230get_trace_reset((notrace,set_prolog_flag(debug,WasDebug),CC3,'$visible'(_, OldV),'$leash'(_, OldL),RestoreTrace)):- 
  231     (notrace(tracing) -> (notrace,RestoreTrace = trace) ; RestoreTrace = notrace),
  232     '$leash'(OldL, OldL),'$visible'(OldV, OldV),
  233     (current_prolog_flag(debug,true)->WasDebug=true;WasDebug=false),     
  234     (current_prolog_flag(gui_tracer, GWas)->CC3=set_prolog_flag(gui_tracer, GWas);CC3=true),!,
  235     RestoreTrace.
  236
  237:- totally_hide(get_trace_reset/1).  238:- totally_hide(get_trace_reset/1).
 push_tracer is det
Push Tracer.
  246push_tracer:- get_trace_reset(Reset)->asserta(t_l:tracer_reset(Reset)).
  247:- totally_hide(push_tracer/0).
 pop_tracer is det
Pop Tracer.
  253pop_tracer:- notrace((retract(t_l:tracer_reset(Reset))->Reset;true)).
  254:- totally_hide(pop_tracer/0).
 reset_tracer is det
Reset Tracer.
  260reset_tracer:- ignore((t_l:tracer_reset(Reset)->Reset;true)).
  261:- totally_hide(reset_tracer/0).  262
  263%:- '$hide'(quietly/1).
  264%:- if_may_hide('totally_hide'(notrace/1,  hide_childs, 1)).
  265%:- if_may_hide('totally_hide'(notrace/1)).
  266:- totally_hide(system:tracing/0).  267:- totally_hide(system:notrace/0).  268:- totally_hide(system:notrace/1).  269:- totally_hide(system:trace/0).  270
  271:- endif.