1/* Part of LogicMOO Base Logicmoo Debug Tools
    2% ===================================================================
    3% File 'with_thread_local.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: 'with_thread_local.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% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_with_assertions.pl
   14:- module(locally_each,
   15          [ locally/2,
   16            locally_each/2,
   17            locally_tl/2,
   18            locally_hide/2,
   19            locally_hide_each/2,
   20            local_override/2
   21          ]).   22
   23:- meta_predicate
   24        locally((:),(:)),
   25        locally_each((:),(:)),
   26        locally_hide((:),(:)),        
   27        locally_hide_each((:),(:)),
   28        wtl(+,*,0,3),
   29        wtl_how(3,0,0,0,0).        
   30
   31:- use_module(library(logicmoo_startup)).   32:- use_module(library(must_sanity)).   33
   34        
   35:- module_transparent
   36        check_thread_local_1m/1,
   37        each_call_cleanup_local/3,
   38        to_thread_local_1m/3,
   39        key_asserta/2,
   40        locally_tl/2,
   41        key_erase/1,
   42        module_effect/3,
   43        module_effect_ue/3.   44
   45
   46:- set_module(class(library)).   47
   48%:- use_module(library(no_repeats)).
   49:- system:use_module(library(logicmoo/each_call)).
 locally_hide_each(:Fact, :Call) is nondet
Temporally Disable Fact with Fact :- !,fail.

use locally_hide_each/3 if respecting Non-determism is important (slightly slower?)

   59locally_hide(Fact,Cm:Call):-
   60  quietly(module_effect((Fact :- !,fail),M,BareEffect)) ->
   61    wtl(M,BareEffect,Cm:Call,Cm:setup_call_cleanup).
 locally_hide_each(:Fact, :Call) is nondet
Temporally Disable Fact with Fact :- !,fail.

But Ensure Non-determism is respected (slightly slower?)

uses each_call_cleanup/3 instead of setup_call_cleanup/3

   71locally_hide_each(Fact,Cm:Call):-  
   72  quietly(module_effect((Fact :- !,fail),M,BareEffect)) ->
   73    wtl(M,BareEffect,Cm:Call,Cm:each_call_cleanup).
 locally_each(:Effect, :Call) is nondet
Temporally have :Effect (see locally/2)

But Ensure Non-determism is respected (effect is undone between Redos)

uses each_call_cleanup/3 instead of setup_call_cleanup/3 (slightly slower?)

for example,

locally_each/2 works (Does not throw)

?- current_prolog_flag(xref,Was), locally_each(set_prolog_flag(xref,true), assertion(current_prolog_flag(xref,true));assertion(current_prolog_flag(xref,true))), assertion(current_prolog_flag(xref,Was)),fail. ===

locally/2 does not work (it throws instead)

?- current_prolog_flag(xref,Was), locally(set_prolog_flag(xref,true), assertion(current_prolog_flag(xref,true));assertion(current_prolog_flag(xref,true))), assertion(current_prolog_flag(xref,Was)),fail. ===
  101locally_each(Em:Effect,Cm:Call):- wtl(Em,Effect,Cm:Call,Cm:each_call_cleanup).
 locally(:Effect, :Call) is nondet
Effect may be of type:
set_prolog_flag - Temporarily change prolog flag
op/3 - change op
$gvar=Value - set a global variable

Temporally (thread_local) Assert some :Effect

use locally_each/3 if respecting Non-determism is important (slightly slower?)

=== ?- current_prolog_flag(xref,Was), locally(set_prolog_flag(xref,true), assertion(current_prolog_flag(xref,true))), assertion(current_prolog_flag(xref,Was)). ===
  130% locally(Em:Effect,Cm:Call):- ground(Call),!,wtl(Em,Effect,Cm:Call,Cm:setup_call_cleanup).
  131locally(Em:Effect,Cm:Call):- wtl(Em,Effect,Cm:Call,Cm:each_call_cleanup).
  132
  133locally_tl(Effect,Call):- locally(t_l:Effect,Call).
  134
  135local_override(N,V):- nb_current(N,V0),!,V0=V.
  136
  137wtl(_,[],Call,_):- !,Call.
  138wtl(M,+With,Call,How):- !,wtl(M,With,Call,How).
  139wtl(M,-[With|MORE],Call,How):- !,wtl(M,-With,wtl(M,-MORE,Call,How),How).
  140wtl(M,[With|MORE],Call,How):- !,wtl(M,With,wtl(M,MORE,Call,How),How).
  141wtl(M,(With,MORE,How),Call,How):- !,wtl(M,With,wtl(M,MORE,Call,How),How).
  142wtl(M,(With;MORE,How),Call,How):- !,wtl(M,With,Call,How);wtl(M,MORE,Call,How).
  143wtl(M,not(With),Call,How):- !,wtl(M,- With,Call,How).
  144wtl(M,-With,Call,setup_call_cleanup):- !,locally_hide(M:With,Call).
  145wtl(M,-With,Call,_How):- !,locally_hide_each(M:With,Call).
  146
  147
  148wtl(M,op(New,XFY,OP),Call,_How):- 
  149  (M:current_op(PrevN,XFY,OP);PrevN=0),!,
  150   wtl_how(trusted_redo_call_cleanup, PrevN==New , op(New,XFY,OP), Call, op(PrevN,XFY,OP)).
  151
  152wtl(M,set_prolog_flag(N,VALUE),Call,_How):- !,
  153  (M:current_prolog_flag(N,WAS);WAS=unknown_flag_error(M:set_prolog_flag(N,VALUE))),!,
  154   wtl_how(trusted_redo_call_cleanup, VALUE==WAS, M:set_prolog_flag(N,VALUE),Call,M:set_prolog_flag(N,WAS)).
  155
  156wtl(M,current_prolog_flag(N,VALUE),Call,_How):- !,
  157  (M:current_prolog_flag(N,WAS);WAS=unknown_flag_error(M:set_prolog_flag(N,VALUE))),!,
  158   wtl_how(trusted_redo_call_cleanup, VALUE==WAS, M:set_prolog_flag(N,VALUE),Call,M:set_prolog_flag(N,WAS)).
  159
  160wtl(M,local_override(N,VALUE),Call,_How):- !,  
  161   M:(nb_current(N,WAS) -> 
  162    call_cleanup((b_setval(N,VALUE),Call,b_setval(N,WAS)),b_setval(N,WAS));
  163    call_cleanup((b_setval(N,VALUE),Call,nb_delete(N)),nb_delete(N))).
  164
  165wtl(M,nb_setval(N,VALUE),Call,_How):- !,  
  166   M:(nb_current(N,WAS) -> 
  167    call_cleanup((nb_setval(N,VALUE),Call,nb_setval(N,WAS)),nb_setval(N,WAS));
  168    call_cleanup((nb_setval(N,VALUE),Call,nb_delete(N)),nb_delete(N))).
  169
  170wtl(M,$(N)=VALUE,Call,How):- !,
  171    wtl(M,local_override(N,VALUE),Call,How).
  172
  173wtl(M,b_setval(N,VALUE),Call,How):- !,
  174    wtl(M,local_override(N,VALUE),Call,How).
  175
  176% undocumented
  177wtl(M,before_after(Before,After,How),Call,How):- !,
  178     (M:Before -> call(How,true,Call,M:After); Call).
  179
  180wtl(_,M:With,Call,How):- quietly(module_effect_ue(M:With,N,O))-> (O\==M:With),!,wtl(N,O,Call,How).
  181wtl(M,With,Call,How):- quietly(module_effect_ue(M:With,N,O))-> (O\==With),!,wtl(N,O,Call,How).
  182
  183wtl(M,Assert,Call,setup_call_cleanup):- !,
  184   wtl_how(setup_call_cleanup,clause_true(M,Assert),M:asserta(Assert,Ref),Call,M:erase(Ref)).
  185
  186wtl(M,Assert,Call,How):- 
  187   wtl_how(How,clause_true(M,Assert),
  188      key_asserta(M,Assert),Call,key_erase(M)).
  189
  190clause_true(M,(H:-B)):- !, functor(H,F,A),functor(HH,F,A),M:nth_clause(HH,1,Ref),M:clause(HH,BB,Ref),!,(H:-B)=@=(HH:-BB).
  191clause_true(M, H    ):- copy_term(H,HH),M:clause(H,true),!,H=@=HH.
  192
  193% wtl_how(How, Test , Pre , Call, Post)
  194
  195%wtl_how(setup_call_cleanup, Test , Pre , Call, Post):- !, (Test -> Call ; setup_call_cleanup(Pre , Call, Post)).
  196%wtl_how(setup_call_cleanup, Test , Pre , Call, Post):- !, (Test -> Call ; setup_call_cleanup(Pre , Call, Post)).
  197wtl_how(setup_call_cleanup, _Test , Pre , Call, Post):- !, each_call_cleanup_local(Pre , Call, Post).
  198wtl_how(each_call_cleanup, _Test , Pre , Call, Post):- each_call_cleanup(Pre , Call, Post).
  199wtl_how(How, Test , Pre , Call, Post):-  Test -> Call ; call(How, Pre , Call, Post).
  200
  201each_call_cleanup_local(Pre,Call,Post):- 
  202  redo_call_cleanup(Pre,Call,Post).
  203
  204:- thread_initialization(nb_setval('$w_tl_e',[])).  205:- initialization(nb_setval('$w_tl_e',[]),restore).  206
  207key_asserta(M,Assert):- M:asserta(Assert,Ref),
  208 (nb_current('$w_tl_e',Was)->nb_linkval('$w_tl_e',[(Ref)|Was]);nb_setval('$w_tl_e',[(Ref)])).
  209
  210key_erase(M):- once(ignore(((nb_current('$w_tl_e',[(Ref)|Was])->(nb_linkval('$w_tl_e',Was)->catch(M:erase(Ref),E,dmsg(E))))))).
  211
  212
  213
  214un_user(user:P,P):-!.
  215un_user(system:P,P):-!.
  216un_user(user:CMDI,CMDI):-!.
  217un_user(logicmoo_webbot:CMDI,CMDI):-!.
  218un_user(eggdrop:CMDI,CMDI):-!.
  219un_user(with_thread_local:P,P):-!.
  220un_user(P,P).
  221
  222module_effect_e(M,H,HH):-
  223  quietly(module_effect(H,MNew,LH)),
  224  (MNew == M -> HH=LH ; HH= MNew:LH).
  225
  226module_effect_ue(MP,M,P):-module_effect(MP,M,PU), un_user(PU,P).
  227
  228module_effect(+M:Call,M,+Call).
  229module_effect(M: +Call,M,+Call).
  230module_effect(-M:Call,M,-Call).
  231module_effect(M: -Call,M,-Call).
  232module_effect(_:op(N,XFY,M:OP),M,op(N,XFY,OP)).
  233module_effect(M:set_prolog_flag(FM:Flag,Value),M,set_prolog_flag(FM:Flag,Value)).
  234module_effect(M:set_prolog_flag(Flag,Value),M,set_prolog_flag(M:Flag,Value)).
  235%module_effect(FM:set_prolog_flag(Flag,Value),FM,set_prolog_flag(FM:Flag,Value)).
  236module_effect($(M):N=V,M,$(N)=V).
  237module_effect(M:[H|T],M,[HH|TT]):-
  238  maplist(module_effect_e(M),[H|T],[HH|TT]).
  239  
  240module_effect(Assert,Module,ThreadLocal):-
  241   module_effect_striped(Assert,Module,Stripped),
  242   to_thread_local_1m(Stripped,Module,ThreadLocal).
  243
  244module_effect(Call,Module,UnQCall):- strip_module(Call,Module,UnQCall).
  245
  246
  247module_effect_striped(_:((M:H):-B), M,(H:-B)).
  248module_effect_striped(M:(H:-B), M,(H:-B)).
  249module_effect_striped(((M:H):-B), M,(H:-B)).
  250module_effect_striped(Call,Module,UnQCall):- strip_module(Call,Module,UnQCall).
 to_thread_local_1m(?Call, ?Module, ?ThreadLocal) is det
Converted To Thread Local Head
  257to_thread_local_1m(MM:HEAD,I,O):- MM = (M:M), !,to_thread_local_1m(M:HEAD,I,O).
  258to_thread_local_1m((TL:Head :- BODY),_,(TL:Head :- BODY)):- nonvar(TL),check_thread_local_1m(TL:Head).
  259to_thread_local_1m((H:-B),TL,(HH:-B)):-!,to_thread_local_1m(H,TL,HH).
  260to_thread_local_1m(Head,baseKB,t_l:Head).
  261to_thread_local_1m(Head,t_l,t_l:Head).
  262to_thread_local_1m(Head,tlbugger,tlbugger:Head).
  263to_thread_local_1m(Head,TL,TL:Head):-check_thread_local_1m(TL:Head).
 check_thread_local_1m(?TLHead) is nondet
Check Thread Local 1m.
  270check_thread_local_1m(_):- \+ current_prolog_flag(runtime_safety,3), \+ current_prolog_flag(runtime_speed,0).
  271check_thread_local_1m(t_l:_):-!.
  272check_thread_local_1m((H:-_)):-!,check_thread_local_1m(H).
  273check_thread_local_1m(tlbugger:_):-!.
  274check_thread_local_1m(lmcache:_):-!.
  275check_thread_local_1m(TLHead):- predicate_property(TLHead,(thread_local)).
  276
  277
  278:- if(current_predicate(fixup_exports/0)).  279:- fixup_exports.  280:- endif.