1:- module(lockable_vars,[
    2   lock_vars/1,
    3   unlock_vars/1,
    4   with_vars_unlocked/1,
    5   with_vars_relocked/1,
    6   with_vars_locked/1,
    7   with_vars_locked/2,
    8   with_some_vars_locked/2,
    9   with_vars_locked/3,
   10   with_vars_locked_old/2,
   11   with_vars_locked_old/3,
   12   with_vars_locked_trusted/3,
   13   with_quiet_vars_lock/1,
   14   with_vars_lock_else/2,
   15   skip_varlocks/0]).

Utility LOGICMOO LOCKABLE VARS

This module prevents bugs due accidental tampering, allows one to write code that keeps free variables from being accidently tampered with unification one way.

author
- Douglas R. Miles
license
- LGPL */
   23:- set_module(class(library)).   24
   25%:- use_module(util_varnames,[get_var_name/2]).
 lock_vars(:TermVar) is semidet
Lock Variables.
   33lock_vars(Term):-lock_vars(lockable_vars:just_fail,Term).
   34
   35just_fail(_):- notrace( \+ skip_varlocks),!.
   36just_fail(_).
   37%skip_varlocks:- !.
   38skip_varlocks:- current_prolog_flag(skip_varlocks , TF),!,TF==true.
   39skip_varlocks:- current_prolog_flag(unsafe_speedups , true) ,!.
   40
   41:- set_prolog_flag(skip_varlocks,false).   42
   43:- meta_predicate(lock_vars(1,+)).   44lock_vars(_Notify,Var):- notrace(skip_varlocks; Var==[]),!.
   45%lock_vars(Notify,[Var]):- !, put_attr(Var,vl,when_rest(Notify,1,Var,vv(Var))).
   46lock_vars(Notify,[Var|Vars]):- !, PVs=..[vv|[Var|Vars]], 
   47 lock_these_vars_now(Notify,1,[Var|Vars],PVs),!.
   48
   49lock_vars(Notify,Term):- term_variables(Term,Vs),lock_vars(Notify,Vs).
   50
   51lock_these_vars_now(Notify,N0,[Var|Vars],PVs):-!,
   52  ignore((var(Var),
   53    put_attr(Var,vl,when_rest(Notify,N0,Var,PVs)))), 
   54   N is N0+1,
   55   lock_these_vars_now(Notify,N,Vars,PVs).
   56lock_these_vars_now(_,_,[],_).
   57
   58vl:attr_unify_hook(InSLock,Value):-
   59  current_prolog_flag(skip_varlocks,true)-> true;
   60  with_vars_unlocked(vl_attr_unify_hook(InSLock,Value)).
   61
   62vl_attr_unify_hook(InSLock,Value):- compound(InSLock), InSLock = slock(InLock,Else,Sorted),!,
   63  check_slock(InLock,Else,InSLock,Sorted,Value).
   64vl_attr_unify_hook(A,B):- vlauh(A,B),!.
   65
   66vlauh(when_rest(Notify,N,_Var,VVs),VarValue):- 
   67    arg(NN,VVs,Was),Was==VarValue,
   68    NN\==N,!,
   69    dmsg(collide_locked_var(Notify,VarValue)),
   70    call(Notify,VarValue).
   71
   72%vlauh(when_rest(_,_,Var,_),VarValue):- unify_name_based0(Var, VarValue).
   73%vlauh(_,VarValue):- locking_verbatum_var(VarValue),!,variable_name_or_ref(VarValue,_),!.
   74
   75vlauh(_,_):- current_prolog_flag(skip_varlocks,true),!.
   76
   77vlauh(_,_):- on_x_fail(( \+ thread_self_main)),!,fail.
   78%vlauh(_,_):- thread_self_main,!.
   79vlauh(when_rest(Notify,N,Var,VVs),VarValue):- 
   80  \+ (var(VarValue);locking_verbatum_var(VarValue)),!,               
   81  dmsg(error_locked_var1(when_rest(Notify,N,Var,VVs),VarValue)),
   82  (current_prolog_flag(debugg,true)->((dumpST,
   83  dmsg(error_locked_var2(when_rest(Notify,N,Var,VVs),VarValue))));true),
   84  (current_prolog_flag(debugg,true)->break;true),
   85  call(Notify,VarValue),!.
   86
   87vlauh(when_rest(Notify,N,Var,VVs),VarValue):- var(VarValue),!,
   88      (get_attr(VarValue,vl,when_rest(Notify,N,Var,VVs))
   89      -> fail ; 
   90         put_attr(VarValue,vl,when_rest(Notify,N,Var,VVs))).
   91
   92vlauh(_,VarValue):- locking_verbatum_var(VarValue),!,variable_name_or_ref(VarValue,_),!.
   93
   94
   95% move to logicmoo_utils_common.pl? 
   96locking_verbatum_var(Var):-var(Var),!,fail.
   97locking_verbatum_var('$VAR'(_)).
   98locking_verbatum_var('aVar'(_)).
   99locking_verbatum_var('aVar'(_,_)).
  100
  101:- thread_local(t_l:varname_lock/1).  102
  103unify_name_based0(Var1, Var2):- \+ atom(Var1),variable_name_or_ref(Var1,Name),!,unify_name_based0(Name, Var2).
  104unify_name_based0(Name1, Var):- if_defined(t_l:var_locked(What),fail),!,((get_var_name(Var,Name2),Name1==Name2)->true;call(What,Var)).
  105unify_name_based0(_Form, _OtherValue):- local_override(no_kif_var_coroutines,G),!,call(G).
  106unify_name_based0(Name1, Var):-  get_var_name(Var,Name2),!,Name1=Name2,!.
  107unify_name_based0(Name1, Var):- get_attr(Var, vn, Name2),!,combine_varnames(Name1,Name2,Name),(Name2==Name->true;put_attr(Var,vn,Name)).
  108unify_name_based0(Name1, Var):- var(Var),!,put_attr(Var, vn, Name1).
  109unify_name_based0(_, Var):- nonvar(Var),!.
  110%unify_name_based0(_, Var):- cyclic_term(Var),!,fail.
  111%unify_name_based0(_, Var):- cyclic_term(Var),!.
  112%unify_name_based0(_, Var):- cyclic_break(Var),!,fail.
  113unify_name_based0(_Form, _OtherValue):-!.
  114
  115combine_varnames(Name1,Name2,Name1):-Name1==Name2,!.
  116combine_varnames(Name1,Name2,Name):-
  117 ((atom_concat(_,Name1,Name2);atom_concat(Name1,_,Name2)) -> Name=Name2 ; (
  118   ((atom_concat(Name2,_,Name1);atom_concat(_,Name2,Name1)) -> Name=Name1 ; (
  119   (atomic_list_concat([Name2,'_',Name1],Name)))))).
 unlock_vars(:TermOrVar) is semidet
Unlock Variables.
  127%unlock_vars(_Var):- notrace(skip_varlocks),!.
  128unlock_vars(Term):- must(quietly((term_attvars(Term,Vs),maplist(delete_vl,Vs)))).
  129
  130delete_vl( Var):- var(Var),!, del_attr(Var,vl).
  131delete_vl( Term):- term_attvars(Term,Vs),maplist(delete_vl,Vs).
  132
  133% % % OFF :- system:use_module(library(logicmoo/each_call)).
  134
  135:- meta_predicate(with_vars_locked_old(1,:)).  136with_vars_locked_old(Notify,Goal):- term_variables(Goal,Vs),with_vars_locked_old(Notify,Vs,Goal).
  137
  138:- meta_predicate(with_vars_locked_old(1,?,:)).  139with_vars_locked_old(_Notify,_Vs,Goal):- notrace(skip_varlocks),!,Goal.
  140with_vars_locked_old(Notify,Vs0,Goal):- term_variables(Vs0,Vs),with_vars_locked_trusted(Notify,Vs,Goal).
  141
  142:- meta_predicate(with_vars_locked_trusted(1,?,:)).  143with_vars_locked_trusted(_Notify,_Vs,Goal):- notrace(skip_varlocks),!,Goal.
  144with_vars_locked_trusted(Notify,Vs,Goal):- set_prolog_flag(access_level,system),
  145 trusted_redo_call_cleanup(
  146   lock_vars(Notify,Vs),
  147      (nop(trace),Goal),
  148     maplist(delete_vl,Vs)).
  149
  150
  151:- thread_local(t_l:on_vars_lock_failed/1).  152
  153:- meta_predicate(with_vars_locked(:)).  154with_vars_locked(Goal):- with_vars_locked(Goal,Goal).
  155
  156:- meta_predicate(with_some_vars_locked(+,:)).  157with_some_vars_locked(_Vars,Goal):-!, Goal.
  158with_some_vars_locked(Vars,Goal):-
  159  with_vars_locked(Vars,Goal) *-> true ; Goal.
  160
  161:- meta_predicate(with_vars_locked(+,:)).  162with_vars_locked(Vars,Goal):- 
  163   term_variables(Vars,Vs),sort(Vs,Sorted),!,   
  164   with_vars_slocked(lookup_how,Sorted,Goal).
  165   %set_prolog_flag(access_level,system), 
  166
  167:- meta_predicate(with_vars_unlocked(:)).  168with_vars_unlocked(Goal):- 
  169  locally(current_prolog_flag(skip_varlocks,true), Goal).
  170
  171:- meta_predicate(with_vars_relocked(0)).  172with_vars_relocked(Goal):- 
  173  locally(current_prolog_flag(skip_varlocks,false), Goal).
  174
  175:- meta_predicate(with_vars_locked(1,+,:)).  176with_vars_locked(Else,Vars,Goal):- 
  177   term_variables(Vars,Vs),sort(Vs,Sorted),!,
  178   with_vars_slocked(Else,Sorted,Goal).
  179   %set_prolog_flag(access_level,system), 
  180
  181vl1:attr_unify_hook(InLock,Value):- with_vars_unlocked(vl1_attr_unify_hook(InLock,Value)).
  182  
  183vl1_attr_unify_hook(InLock,Value):- 
  184  (var(Value)
  185    -> put_attr(Value,vl1,InLock)
  186    ; (InLock=vlock(YesNo,Else),
  187       (YesNo==no->true;Else))).
  188
  189with_vars_slocked(_Else,Sorted,Goal):- notrace(skip_varlocks;Sorted==[]),!,call(Goal).
  190with_vars_slocked(Else,[Var],Goal):- fail,!,
  191 InLock = vlock(no,call(Else,Var)),
  192 setup_call_cleanup(
  193   put_attr(Var,vl1,InLock),
  194   call_in_lock(InLock,Goal),
  195   del_attr(Var,vl1)).
  196
  197with_vars_slocked(Else,Sorted,Goal):-
  198   InLock = slock(no,Else,Sorted),
  199   setup_call_cleanup(
  200      maplist(lock_as_sorted(InLock),Sorted),
  201      call_in_lock(InLock,Goal),
  202      maplist(unlock_as_sorted(InLock),Sorted)).
  203
  204call_in_lock(InLock,Goal):- 
  205  %set_prolog_flag(access_level,system),
  206   trusted_redo_call_cleanup(
  207    nb_setarg(1,InLock,yes),
  208    Goal,
  209    nb_setarg(1,InLock,no)).
  210
  211lock_as_sorted(InLock,Var):- put_attr(Var,vl,InLock).
  212unlock_as_sorted(InLock,Var):-  ignore((attvar(Var),get_attr(Var,vl,InLockW),InLock==InLockW,del_attr(Var,vl))).
  213
  214:- meta_predicate(check_slock(+,:,+,+,+)).  215check_slock(no,_Else,InSLock,_Sorted,Value):- !,
  216  ((var(Value), \+ get_attr(Value,vl,_)) -> put_attr(Value,vl,InSLock);  true).
  217check_slock(yes,Else,InSLock,Sorted,Value):- 
  218  (test_slock(yes,Else,InSLock,Sorted,Value)-> true ; 
  219    failed_slock(yes,Else,InSLock,Sorted,Value)),!.
  220
  221:- meta_predicate(failed_slock(+,:,+,+,+)).  222failed_slock(yes,_:Else,_InSLock,_Sorted,_Value):- builtin_slock(Else),!,fail.
  223failed_slock(yes,_:lookup_how,InSLock,Sorted,Value):-!,
  224  (t_l:on_vars_lock_failed(Else)-> failed_slock(yes,Else,InSLock,Sorted,Value);fail).
  225failed_slock(yes,Else,InSLock,_Sorted,_Value):- trace,call(Else,InSLock),fail.
  226
  227:- meta_predicate(builtin_slock(*)).  228builtin_slock(just_fail):- !.
  229builtin_slock(fail):- !.
  230builtin_slock(trace):- !,trace.
  231builtin_slock(dbreak):- !,dbreak.
  232
  233:- meta_predicate(with_quiet_vars_lock(:)).  234with_quiet_vars_lock(M:G):- with_vars_lock_else(M:just_fail,M:G).
  235
  236:- meta_predicate(with_vars_lock_else(1,:)).  237with_vars_lock_else(Else,M:G):- 
  238  locally(t_l:on_vars_lock_failed(M:Else),M:G).
  239
  240
  241test_slock(yes,_Else,InSLock,Sorted,Value):-
  242  var(Value), 
  243  sort(Sorted,SortedW1),Sorted==SortedW1,
  244  (get_attr(Value,vl,slock(_VYN,_VElse,VSorted)) 
  245      -> VSorted \== Sorted ; put_attr(Value,vl,InSLock)).
  246
  247  
  248
  249/*vl:attr_unify_hook(InSLock,Value):- assertion(InSLock = slock(InLock,Else,Sorted)),
  250  InSLock = slock(InLock,Else,Sorted),
  251  check_slock(InLock,Else,InSLock,Sorted,Value).
  252*/