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 w_o_c/1, 22 w_o_c/2 23 ]). 24 25:- meta_predicate 26 locally(,), 27 locally_each(,), 28 locally_hide(,), 29 locally_hide_each(,), 30 wtl(,,,), 31 wtl_how(,,,,).
39% :- system:use_module(library(logicmoo_startup)). 40% % % OFF :- system:use_module(library(must_sanity)). 41 42 43:- module_transparent 44 check_thread_local_1m/1, 45 each_call_cleanup_local/3, 46 to_thread_local_1m/3, 47 key_asserta/2, 48 locally_tl/2, 49 key_erase/1, 50 module_effect/3, 51 module_effect_ue/3. 52 53 54:- set_module(class(library)). 55% WAS OFF :- system:use_module(library(no_repeats)). 56% % % OFF :- system:use_module(library(logicmoo/each_call)). 57:- use_module('./each_call').
Fact :- !,fail.
use locally_hide_each/3 if respecting Non-determism is important (slightly slower?)
67locally_hide(Fact,Cm:Call):-
68 quietly(module_effect((Fact :- !,fail),M,BareEffect)) ->
69 wtl(M,BareEffect,Cm:Call,Cm:setup_call_cleanup).Fact :- !,fail.
But Ensure Non-determism is respected (slightly slower?)
uses each_call_cleanup/3 instead of setup_call_cleanup/3
79locally_hide_each(Fact,Cm:Call):- 80 quietly(module_effect((Fact :- !,fail),M,BareEffect)) -> 81 wtl(M,BareEffect,Cm:Call,Cm:each_call_cleanup). 82 83:- meta_predicate(w_o_c()). 84 85w_o_c(G):- tracing,!,call(G). 86w_o_c(G):- catch(w_o_c(error, G),E, 87 (wdmsg(w_o_c(error=E, G)),dumpST,wdmsg(w_o_c(error=E, G)),break,trace,G)). 88 89:- meta_predicate(w_o_c(,)). 90w_o_c(How, G):- 91 locally(set_prolog_flag(occurs_check,How),G).
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,
?- 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.
===
?- 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.
===
119locally_each(Em:Effect,Cm:Call):- wtl(Em,Effect,Cm:Call,Cm:each_call_cleanup).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)).
===
148% locally(Em:Effect,Cm:Call):- ground(Call),!,wtl(Em,Effect,Cm:Call,Cm:setup_call_cleanup). 149locally(Em:Effect,Cm:Call):- wtl(Em,Effect,Cm:Call,Cm:each_call_cleanup). 150 151locally_tl(Effect,Call):- locally(t_l:Effect,Call). 152 153local_override(N,V):- nb_current(N,V0),!,V0=V. 154 155wtl(_,[],Call,_):- !,. 156wtl(M,+With,Call,How):- !,wtl(M,With,Call,How). 157wtl(M,-[With|MORE],Call,How):- !,wtl(M,-With,wtl(M,-MORE,Call,How),How). 158wtl(M,[With|MORE],Call,How):- !,wtl(M,With,wtl(M,MORE,Call,How),How). 159wtl(M,(With,MORE,How),Call,How):- !,wtl(M,With,wtl(M,MORE,Call,How),How). 160wtl(M,(With;MORE,How),Call,How):- !,wtl(M,With,Call,How);wtl(M,MORE,Call,How). 161wtl(M,not(With),Call,How):- !,wtl(M,- With,Call,How). 162wtl(M,-With,Call,setup_call_cleanup):- !,locally_hide(M:With,Call). 163wtl(M,-With,Call,_How):- !,locally_hide_each(M:With,Call). 164 165 166wtl(M,op(New,XFY,OP),Call,_How):- 167 (M:current_op(PrevN,XFY,OP);PrevN=0),!, 168 wtl_how(trusted_redo_call_cleanup, PrevN==New , op(New,XFY,OP), Call, op(PrevN,XFY,OP)). 169 170wtl(M,set_prolog_flag(N,VALUE),Call,_How):- !, 171 (M:current_prolog_flag(N,WAS);WAS=unknown_flag_error(M:set_prolog_flag(N,VALUE))),!, 172 wtl_how(trusted_redo_call_cleanup, VALUE==WAS, M:set_prolog_flag(N,VALUE),Call,M:set_prolog_flag(N,WAS)). 173 174wtl(M,current_prolog_flag(N,VALUE),Call,_How):- !, 175 (M:current_prolog_flag(N,WAS);WAS=unknown_flag_error(M:set_prolog_flag(N,VALUE))),!, 176 wtl_how(trusted_redo_call_cleanup, VALUE==WAS, M:set_prolog_flag(N,VALUE),Call,M:set_prolog_flag(N,WAS)). 177 178wtl(M,local_override(N,VALUE),Call,_How):- !, 179 M:(nb_current(N,WAS) -> 180 call_cleanup((b_setval(N,VALUE),Call,b_setval(N,WAS)),b_setval(N,WAS)); 181 call_cleanup((b_setval(N,VALUE),Call,nb_delete(N)),nb_delete(N))). 182 183wtl(M,nb_setval(N,VALUE),Call,_How):- !, 184 M:(nb_current(N,WAS) -> 185 call_cleanup((nb_setval(N,VALUE),Call,nb_setval(N,WAS)),nb_setval(N,WAS)); 186 call_cleanup((nb_setval(N,VALUE),Call,nb_delete(N)),nb_delete(N))). 187 188wtl(M,$(N)=VALUE,Call,How):- !, 189 wtl(M,local_override(N,VALUE),Call,How). 190 191wtl(M,b_setval(N,VALUE),Call,How):- !, 192 wtl(M,local_override(N,VALUE),Call,How). 193 194% undocumented 195wtl(M,before_after(Before,After,How),Call,How):- !, 196 (M:Before -> call(How,true,Call,M:After); ). 197 198wtl(_,M:With,Call,How):- quietly(module_effect_ue(M:With,N,O))-> (O\==M:With),!,wtl(N,O,Call,How). 199wtl(M,With,Call,How):- quietly(module_effect_ue(M:With,N,O))-> (O\==With),!,wtl(N,O,Call,How). 200 201wtl(M,Assert,Call,setup_call_cleanup):- !, 202 wtl_how(setup_call_cleanup,clause_true(M,Assert),M:asserta(Assert,Ref),Call,M:erase(Ref)). 203 204wtl(M,Assert,Call,How):- 205 wtl_how(How,clause_true(M,Assert), 206 key_asserta(M,Assert),Call,key_erase(M)). 207 208clause_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). 209clause_true(M, H ):- copy_term(H,HH),M:clause(H,true),!,H=@=HH. 210 211% wtl_how(How, Test , Pre , Call, Post) 212 213%wtl_how(setup_call_cleanup, Test , Pre , Call, Post):- !, (Test -> Call ; setup_call_cleanup(Pre , Call, Post)). 214%wtl_how(setup_call_cleanup, Test , Pre , Call, Post):- !, (Test -> Call ; setup_call_cleanup(Pre , Call, Post)). 215wtl_how(setup_call_cleanup, _Test , Pre , Call, Post):- !, each_call_cleanup_local(Pre , Call, Post). 216wtl_how(each_call_cleanup, _Test , Pre , Call, Post):- each_call_cleanup(Pre , Call, Post). 217wtl_how(How, Test , Pre , Call, Post):- -> ; call(How, Pre , Call, Post). 218 219each_call_cleanup_local(Pre,Call,Post):- 220 redo_call_cleanup(Pre,Call,Post). 221 222:- thread_initialization(nb_setval('$w_tl_e',[])). 223:- initialization(nb_setval('$w_tl_e',[]),restore). 224 225key_asserta(M,Assert):- M:asserta(Assert,Ref), 226 (nb_current('$w_tl_e',Was)->nb_linkval('$w_tl_e',[(Ref)|Was]);nb_setval('$w_tl_e',[(Ref)])). 227 228key_erase(M):- once(ignore(((nb_current('$w_tl_e',[(Ref)|Was])->(nb_linkval('$w_tl_e',Was)->catch(M:erase(Ref),E,dmsg(E))))))). 229 230 231 232un_user(user:P,P):-!. 233un_user(system:P,P):-!. 234un_user(user:CMDI,CMDI):-!. 235un_user(logicmoo_webbot:CMDI,CMDI):-!. 236un_user(eggdrop:CMDI,CMDI):-!. 237un_user(with_thread_local:P,P):-!. 238un_user(P,P). 239 240module_effect_e(M,H,HH):- 241 quietly(module_effect(H,MNew,LH)), 242 (MNew == M -> HH=LH ; HH= MNew:LH). 243 244module_effect_ue(MP,M,P):-module_effect(MP,M,PU), un_user(PU,P). 245 246module_effect(+M:Call,M,+Call). 247module_effect(M: +Call,M,+Call). 248module_effect(-M:Call,M,-Call). 249module_effect(M: -Call,M,-Call). 250module_effect(_:op(N,XFY,M:OP),M,op(N,XFY,OP)). 251module_effect(M:set_prolog_flag(FM:Flag,Value),M,set_prolog_flag(FM:Flag,Value)). 252module_effect(M:set_prolog_flag(Flag,Value),M,set_prolog_flag(M:Flag,Value)). 253%module_effect(FM:set_prolog_flag(Flag,Value),FM,set_prolog_flag(FM:Flag,Value)). 254module_effect($(M):N=V,M,$(N)=V). 255module_effect(M:[H|T],M,[HH|TT]):- 256 maplist(module_effect_e(M),[H|T],[HH|TT]). 257 258module_effect(Assert,Module,ThreadLocal):- 259 module_effect_striped(Assert,Module,Stripped), 260 to_thread_local_1m(Stripped,Module,ThreadLocal). 261 262module_effect(Call,Module,UnQCall):- strip_module(Call,Module,UnQCall). 263 264 265module_effect_striped(_:((M:H):-B), M,(H:-B)). 266module_effect_striped(M:(H:-B), M,(H:-B)). 267module_effect_striped(((M:H):-B), M,(H:-B)). 268module_effect_striped(Call,Module,UnQCall):- strip_module(Call,Module,UnQCall).
275to_thread_local_1m(MM:HEAD,I,O):- MM = (M:M), !,to_thread_local_1m(M:HEAD,I,O). 276to_thread_local_1m((TL:Head :- BODY),_,(TL:Head :- BODY)):- nonvar(TL),check_thread_local_1m(TL:Head). 277to_thread_local_1m((H:-B),TL,(HH:-B)):-!,to_thread_local_1m(H,TL,HH). 278to_thread_local_1m(Head,baseKB,t_l:Head). 279to_thread_local_1m(Head,t_l,t_l:Head). 280to_thread_local_1m(Head,tlbugger,tlbugger:Head). 281to_thread_local_1m(Head,TL,TL:Head):-check_thread_local_1m(TL:Head).
288check_thread_local_1m(_):- \+ current_prolog_flag(runtime_safety,3), \+ current_prolog_flag(runtime_speed,0). 289check_thread_local_1m(t_l:_):-!. 290check_thread_local_1m((H:-_)):-!,check_thread_local_1m(H). 291check_thread_local_1m(tlbugger:_):-!. 292check_thread_local_1m(lmcache:_):-!. 293check_thread_local_1m(TLHead):- predicate_property(TLHead,(thread_local)). 294 295 296:- if(current_predicate(fixup_exports/0)). 297:- fixup_exports. 298:- endif.
Utility LOGICMOO_REDO_LOCALLY
This module allows drastic changes to prolog data to happen very temporarily. (to be reset or temporarily changed.) @author Douglas R. Miles @license LGPL */