1:- module(lockable_vars,[
2 lock_vars/1,
3 unlock_vars/1,
4 with_vars_locked/1,
5 with_vars_locked/2,
6 with_some_vars_locked/2,
7 with_vars_locked/3,
8 with_vars_locked_old/2,
9 with_vars_locked_old/3,
10 with_vars_locked_trusted/3,
11 with_quiet_vars_lock/1,
12 with_vars_lock_else/2,
13 skip_varlocks/0]).
14
15:- set_module(class(library)).
24lock_vars(Term):-lock_vars(lockable_vars:just_fail,Term).
25
26just_fail(_):-fail.
27skip_varlocks:- current_prolog_flag(skip_varlocks , TF),!,TF==true.
28skip_varlocks:- current_prolog_flag(unsafe_speedups , true) ,!.
29
30:- set_prolog_flag(skip_varlocks,false).
31
32:- meta_predicate(lock_vars(1,+)).
33lock_vars(_Notify,Var):- notrace(skip_varlocks; Var==[]),!.
35lock_vars(Notify,[Var|Vars]):- !, PVs=..[vv|[Var|Vars]],
36 lock_these_vars_now(Notify,1,[Var|Vars],PVs),!.
37
38lock_vars(Notify,Term):- term_variables(Term,Vs),lock_vars(Notify,Vs).
39
40lock_these_vars_now(Notify,N0,[Var|Vars],PVs):-!,
41 ignore((var(Var),
42 put_attr(Var,vl,when_rest(Notify,N0,Var,PVs)))),
43 N is N0+1,
44 lock_these_vars_now(Notify,N,Vars,PVs).
45lock_these_vars_now(_,_,[],_).
46
47vl:attr_unify_hook(InSLock,Value):- InSLock = slock(InLock,Else,Sorted),!,
48 check_slock(InLock,Else,InSLock,Sorted,Value).
49vl:attr_unify_hook(A,B):- trace, vlauh(A,B),!.
50
51vlauh(when_rest(Notify,N,_Var,VVs),VarValue):-
52 arg(NN,VVs,Was),Was==VarValue,
53 NN\==N,
54 dmsg(collide_locked_var(Notify,VarValue)),
55 call(Notify,VarValue).
56
59
62vlauh(when_rest(Notify,N,Var,VVs),VarValue):-
63 \+ (var(VarValue);locking_verbatum_var(VarValue)),!,
64 dmsg(error_locked_var(when_rest(Notify,N,Var,VVs),VarValue)),
65 call(Notify,VarValue),!.
66
67vlauh(when_rest(Notify,N,Var,VVs),VarValue):- var(VarValue),!,
68 (get_attr(VarValue,vl,when_rest(Notify,N,Var,VVs))
69 -> fail ;
70 put_attr(VarValue,vl,when_rest(Notify,N,Var,VVs))).
71
72vlauh(_,VarValue):- locking_verbatum_var(VarValue),!,variable_name_or_ref(VarValue,_),!.
73
74
76locking_verbatum_var(Var):-var(Var),!,fail.
77locking_verbatum_var('$VAR'(_)).
78locking_verbatum_var('avar'(_)).
79locking_verbatum_var('avar'(_,_)).
80
81:- thread_local(t_l:varname_lock/1).
82
83unify_name_based0(Var1, Var2):- \+ atom(Var1),ger_var_name_or_ref(Var1,Name),!,unify_name_based0(Name, Var2).
84unify_name_based0(Name1, Var):- if_defined(t_l:var_locked(What),fail),!,((get_var_name(Var,Name2),Name1==Name2)->true;call(What,Var)).
85unify_name_based0(_Form, _OtherValue):- local_override(no_kif_var_coroutines,G),!,call(G).
86unify_name_based0(Name1, Var):- get_var_name(Var,Name2),!,Name1=Name2,!.
87unify_name_based0(Name1, Var):- get_attr(Var, vn, Name2),!,combine_varnames(Name1,Name2,Name),(Name2==Name->true;put_attr(Var,vn,Name)).
88unify_name_based0(Name1, Var):- var(Var),!,put_attr(Var, vn, Name1).
89unify_name_based0(_, Var):- nonvar(Var),!.
93unify_name_based0(_Form, _OtherValue):-!.
94
95combine_varnames(Name1,Name2,Name1):-Name1==Name2,!.
96combine_varnames(Name1,Name2,Name):-
97 ((atom_concat(_,Name1,Name2);atom_concat(Name1,_,Name2)) -> Name=Name2 ; (
98 ((atom_concat(Name2,_,Name1);atom_concat(_,Name2,Name1)) -> Name=Name1 ; (
99 (atomic_list_concat([Name2,'_',Name1],Name)))))).
107unlock_vars(_Var):- notrace(skip_varlocks),!.
108unlock_vars(Term):- must(quietly((term_attvars(Term,Vs),maplist(delete_vl,Vs)))).
109
110delete_vl( Var):- var(Var),!, del_attr(Var,vl).
111delete_vl( Term):- term_attvars(Term,Vs),maplist(delete_vl,Vs).
112
113:- use_module(library(each_call_cleanup)).
114
115:- meta_predicate(with_vars_locked_old(1,:)).
116with_vars_locked_old(Notify,Goal):- term_variables(Goal,Vs),with_vars_locked_old(Notify,Vs,Goal).
117
118:- meta_predicate(with_vars_locked_old(1,?,:)).
119with_vars_locked_old(_Notify,_Vs,Goal):- notrace(skip_varlocks),!,Goal.
120with_vars_locked_old(Notify,Vs0,Goal):- term_variables(Vs0,Vs),with_vars_locked_trusted(Notify,Vs,Goal).
121
122:- meta_predicate(with_vars_locked_trusted(1,?,:)).
123with_vars_locked_trusted(Notify,Vs,Goal):- set_prolog_flag(access_level,system),
124 trusted_redo_call_cleanup(
125 lock_vars(Notify,Vs),
126 (trace,Goal),
127 maplist(delete_vl,Vs)).
128
129
130:- thread_local(t_l:on_vars_lock_failed/1).
131
132:- meta_predicate(with_vars_locked(:)).
133with_vars_locked(Goal):- with_vars_locked(Goal,Goal).
134
135:- meta_predicate(with_some_vars_locked(+,:)).
136with_some_vars_locked(_Vars,Goal):-!, Goal.
137with_some_vars_locked(Vars,Goal):-
138 with_vars_locked(Vars,Goal) *-> true ; Goal.
139
140:- meta_predicate(with_vars_locked(+,:)).
141with_vars_locked(Vars,Goal):-
142 term_variables(Vars,Vs),sort(Vs,Sorted),!,
143 with_vars_slocked(lookup_how,Sorted,Goal).
144 145
146:- meta_predicate(with_vars_locked(1,+,:)).
147with_vars_locked(Else,Vars,Goal):-
148 term_variables(Vars,Vs),sort(Vs,Sorted),!,
149 with_vars_slocked(Else,Sorted,Goal).
150 151
152
153vl1:attr_unify_hook(InLock,Value):-
154 (var(Value)
155 -> put_attr(Value,vl1,InLock)
156 ; (InLock=vlock(YesNo,Else),
157 (YesNo==no->true;Else))).
158
159with_vars_slocked(_Else,Sorted,Goal):- notrace(skip_varlocks;Sorted==[]),!,call(Goal).
160with_vars_slocked(Else,[Var],Goal):- fail,!,
161 InLock = vlock(no,call(Else,Var)),
162 setup_call_cleanup(
163 put_attr(Var,vl1,InLock),
164 call_in_lock(InLock,Goal),
165 del_attr(Var,vl1)).
166
167with_vars_slocked(Else,Sorted,Goal):-
168 InLock = slock(no,Else,Sorted),
169 setup_call_cleanup(
170 maplist(lock_as_sorted(InLock),Sorted),
171 call_in_lock(InLock,Goal),
172 maplist(unlock_as_sorted(InLock),Sorted)).
173
174call_in_lock(InLock,Goal):-
175 176 trusted_redo_call_cleanup(
177 nb_setarg(1,InLock,yes),
178 Goal,
179 nb_setarg(1,InLock,no)).
180
181lock_as_sorted(InLock,Var):- put_attr(Var,vl,InLock).
182unlock_as_sorted(InLock,Var):- ignore((attvar(Var),get_attr(Var,vl,InLockW),InLock==InLockW,del_attr(Var,vl))).
183
184:- meta_predicate(check_slock(+,:,+,+,+)).
185check_slock(no,_Else,InSLock,_Sorted,Value):- !,
186 ((var(Value), \+ get_attr(Value,vl,_)) -> put_attr(Value,vl,InSLock); true).
187check_slock(yes,Else,InSLock,Sorted,Value):-
188 (test_slock(yes,Else,InSLock,Sorted,Value)-> true ;
189 failed_slock(yes,Else,InSLock,Sorted,Value)),!.
190
191:- meta_predicate(failed_slock(+,:,+,+,+)).
192failed_slock(yes,_:Else,_InSLock,_Sorted,_Value):- builtin_slock(Else),!,fail.
193failed_slock(yes,_:lookup_how,InSLock,Sorted,Value):-!,
194 (t_l:on_vars_lock_failed(Else)-> failed_slock(yes,Else,InSLock,Sorted,Value);fail).
195failed_slock(yes,Else,InSLock,_Sorted,_Value):- trace,call(Else,InSLock),fail.
196
197:- meta_predicate(builtin_slock(*)).
198builtin_slock(just_fail):- !.
199builtin_slock(fail):- !.
200builtin_slock(trace):- !,trace.
201builtin_slock(dbreak):- !,dbreak.
202
203:- meta_predicate(with_quiet_vars_lock(:)).
204with_quiet_vars_lock(M:G):- with_vars_lock_else(M:just_fail,M:G).
205
206:- meta_predicate(with_vars_lock_else(1,:)).
207with_vars_lock_else(Else,M:G):-
208 locally(t_l:on_vars_lock_failed(M:Else),M:G).
209
210
211test_slock(yes,_Else,InSLock,Sorted,Value):-
212 var(Value),
213 sort(Sorted,SortedW1),Sorted==SortedW1,
214 (get_attr(Value,vl,slock(_VYN,_VElse,VSorted))
215 -> VSorted \== Sorted ; put_attr(Value,vl,InSLock)).
216
217
218