YAP 7.1.0
atts.yap
Go to the documentation of this file.
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: atts.yap *
12* Last rev: 8/2/88 *
13* mods: *
14* comments: attribute support for Prolog *
15* *
16*************************************************************************/
17/**
18 * @file atts.yap
19 */
20:- module(attributes, [op(1150, fx, attribute)]).
21
22/**
23 *
24 * @defgroup sicsatts SICStus style attribute declarations
25 *
26 * @ingroup SICS_attributes
27 *
28 * @{
29 *
30
31 SICStus style attribute declarations are activated through loading the
32 library <tt>atts</tt>. The command
33
34 ~~~~~
35 | ?- use_module(library(atts)).
36 ~~~~~
37 enables this form of attributed variables.
38
39 The directive
40
41 - attribute/1
42
43 and the following user defined predicates can be used:
44
45 - Module:get_atts/2
46
47 - Module:put_atts/2
48
49 - Module:put_atts/3
50
51 - Module:woken_att_do/4
52
53*/
54
55
56:- member/2use_module(library(lists), []).
57
58:- multifile
59 goal_expansion/3.
60 :- multifile
61 term_expansion/2.
62 :- multifile
63 attributed_module/3.
64
65:- dynamic existing_attribute/4.
66:- dynamic modules_with_attributes/1.
67:- dynamic attributed_module/3.
68
69modules_with_attributes([]).
70
71%
72% defining a new attribute is just a question of establishing a
73% Functor, Mod -> INT mappings
74%
75new_attribute(V) :- var(V), var,
76 throw(error(instantiation_error,attribute(V))).
77new_attribute((At1,At2)) :-
78 new_attribute(At1),
79 new_attribute(At2).
80new_attribute(Na/Ar) :-
81 source_module(Mod),
82 functor(S,Na,Ar),
83 existing_attribute(S,Mod,_,_) , existing_attribute.
84new_attribute(Na/Ar) :-
85 source_module(Mod),
86 functor(S,Na,Ar),
87 store_new_module(Mod,Ar,Position),
88 assertz(existing_attribute(S,Mod,Ar,Position)).
89
90store_new_module(Mod,Ar,ArgPosition) :-
91 (
92 retract(attributed_module(Mod,Position,_))
93 ->
94 retract
95 ;
96 retract(modules_with_attributes(Mods)),
97 assert(modules_with_attributes([Mod|Mods])), Position = 2
98 ),
99 ArgPosition is Position+1,
100 ( Ar == 0 -> NOfAtts is Position+1 ; NOfAtts is Position+Ar),
101 functor(AccessTerm,Mod,NOfAtts),
102 assertz(attributed_module(Mod,NOfAtts,AccessTerm)).
103
104:- user_defined_directive(attribute(G), attributes:new_attribute(G)).
105
106/** @pred Module:get_atts( _-Var_, _?ListOfAttributes_)
107
108
109Unify the list _?ListOfAttributes_ with the attributes for the unbound
110variable _Var_. Each member of the list must be a bound term of the
111form `+( _Attribute_)`, `-( _Attribute_)` (the <tt>kbd</tt>
112prefix may be dropped). The meaning of <tt>+</tt> and <tt>-</tt> is:
113 + +( _Attribute_)
114 Unifies _Attribute_ with a corresponding attribute associated with
115 _Var_, fails otherwise.
116
117 + -( _Attribute_)
118 Succeeds if a corresponding attribute is not associated with
119 _Var_. The arguments of _Attribute_ are ignored.
120
121
122*/
123user_defined_directive:goal_expansion(get_atts(Var,AccessSpec), Mod, Goal) :-
124 expand_get_attributes(AccessSpec,Mod,Var,Goal).
125
126/** @pred Module:put_atts( _-Var_, _?ListOfAttributes_)
127
128
129Associate with or remove attributes from a variable _Var_. The
130attributes are given in _?ListOfAttributes_, and the action depends
131on how they are prefixed:
132
133 + +( _Attribute_ )
134 Associate _Var_ with _Attribute_. A previous value for the
135 attribute is simply replace (like with `set_mutable/2`).
136
137 + -( _Attribute_ )
138 Remove the attribute with the same name. If no such attribute existed,
139 simply succeed.
140
141 */
142expand_get_attributes:goal_expansion(put_atts(Var,AccessSpec), Mod, Goal) :-
143 expand_put_attributes(AccessSpec, Mod, Var, Goal).
144
145
146expand_get_attributes(V,_,_,_) :- var(V), var, var.
147expand_get_attributes([],_,_,true) :- expand_get_attributes.
148expand_get_attributes([-G1],Mod,V,attributes:free_att(V,Mod,Pos)) :-
149 existing_attribute(G1,Mod,_,Pos), existing_attribute.
150expand_get_attributes([+G1],Mod,V,attributes:get_att(V,Mod,Pos,A)) :-
151 existing_attribute(G1,Mod,1,Pos), existing_attribute,
152 arg(1,G1,A).
153expand_get_attributes([G1],Mod,V,attributes:get_att(V,Mod,Pos,A)) :-
154 existing_attribute(G1,Mod,1,Pos), existing_attribute,
155 arg(1,G1,A).
156expand_get_attributes(Atts,Mod,Var,attributes:get_module_atts(Var,AccessTerm)) :- Atts = [_|_], ,
157 attributed_module(Mod,NOfAtts,AccessTerm),
158 void_term(Void),
159 cvt_atts(Atts,Mod,Void,LAtts),
160 sort(LAtts,SortedLAtts),
161 free_term(Free),
162 build_att_term(1,NOfAtts,SortedLAtts,Free,AccessTerm).
163expand_get_attributes(Att,Mod,Var,Goal) :-
164 expand_get_attributes([Att],Mod,Var,Goal).
165
166build_att_term(NOfAtts,NOfAtts,[],_,_) :- build_att_term.
167build_att_term(I0,NOfAtts,[I-Info|SortedLAtts],Void,AccessTerm) :-
168 I is I0+1, build_att_term,
169 copy_att_args(Info,I0,NI,AccessTerm),
170 build_att_term(NI,NOfAtts,SortedLAtts,Void,AccessTerm).
171build_att_term(I0,NOfAtts,SortedLAtts,Void,AccessTerm) :-
172 I is I0+1,
173 arg(I,AccessTerm,Void),
174 build_att_term(I,NOfAtts,SortedLAtts,Void,AccessTerm).
175
176cvt_atts(V,_,_,_) :- var(V), var, var.
177cvt_atts([],_,_,[]).
178cvt_atts([V|_],_,_,_) :- var(V), var, var.
179cvt_atts([+Att|Atts],Mod,Void,[Pos-LAtts|Read]) :- cvt_atts,
180 existing_attribute(Att,Mod,_,Pos),
181 (atom(Att) -> LAtts = [_] ; Att=..[_|LAtts]),
182 cvt_atts(Atts,Mod,Void,Read).
183cvt_atts([-Att|Atts],Mod,Void,[Pos-LVoids|Read]) :- cvt_atts,
184 existing_attribute(Att,Mod,_,Pos),
185 (
186 atom(Att)
187 ->
188 LVoids = [Void]
189 ;
190 Att =..[_|LAtts],
191 void_vars(LAtts,Void,LVoids)
192 ),
193 cvt_atts(Atts,Mod,Void,Read).
194cvt_atts([Att|Atts],Mod,Void,[Pos-LAtts|Read]) :- cvt_atts,
195 existing_attribute(Att,Mod,_,Pos),
196 (atom(Att) -> LAtts = [_] ; Att=..[_|LAtts]),
197 cvt_atts(Atts,Mod,Void,Read).
198
199copy_att_args([],I,I,_).
200copy_att_args([V|Info],I,NI,AccessTerm) :-
201 I1 is I+1,
202 arg(I1,AccessTerm,V),
203 copy_att_args(Info,I1,NI,AccessTerm).
204
205void_vars([],_,[]).
206void_vars([_|LAtts],Void,[Void|LVoids]) :-
207 void_vars(LAtts,Void,LVoids).
208
209expand_put_attributes(V,_,_,_) :- var(V), var, var.
210expand_put_attributes([-G1],Mod,V,attributes:rm_att(V,Mod,NOfAtts,Pos)) :-
211 existing_attribute(G1,Mod,_,Pos), existing_attribute,
212 attributed_module(Mod,NOfAtts,_).
213expand_put_attributes([+G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
214 existing_attribute(G1,Mod,1,Pos), existing_attribute,
215 attributed_module(Mod,NOfAtts,_),
216 arg(1,G1,A).
217expand_put_attributes([G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
218 existing_attribute(G1,Mod,1,Pos), existing_attribute,
219 attributed_module(Mod,NOfAtts,_),
220 arg(1,G1,A).
221expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) :- Atts = [_|_], ,
222 attributed_module(Mod,NOfAtts,AccessTerm),
223 void_term(Void),
224 cvt_atts(Atts,Mod,Void,LAtts),
225 sort(LAtts,SortedLAtts),
226 free_term(Free),
227 build_att_term(1,NOfAtts,SortedLAtts,Free,AccessTerm).
228expand_put_attributes(Att,Mod,Var,Goal) :-
229 expand_put_attributes([Att],Mod,Var,Goal).
230
231expand_put_attributes:woken_att_do(AttVar, Binding, NGoals, DoNotBind) :-
232 modules_with_attributes(AttVar,Mods0),
233 modules_with_attributes(Mods),
234 find_used(Mods,Mods0,[],ModsI),
235 do_verify_attributes(ModsI, AttVar, Binding, Goals),
236 process_goals(Goals, NGoals, DoNotBind).
237
238% dirty trick to be able to unbind a variable that has been constrained.
239process_goals([], [], _).
240process_goals([(M:do_not_bind_variable(Gs))|Goals], (M:Gs).NGoals, true) :- process_goals,
241 process_goals(Goals, NGoals, _).
242process_goals(G.Goals, G.NGoals, Do) :-
243 process_goals(Goals, NGoals, Do).
244
245find_used([],_,L,L).
246find_used([M|Mods],Mods0,L0,Lf) :-
247 member(M,Mods0), member,
248 find_used(Mods,Mods0,[M|L0],Lf).
249find_used([_|Mods],Mods0,L0,Lf) :-
250 find_used(Mods,Mods0,L0,Lf).
251
252/** @pred Module:verify_attributes( _-Var_, _+Value_, _-Goals_)
253
254The predicate is called when trying to unify the attributed variable
255 _Var_ with the Prolog term _Value_. Note that _Value_ may be
256itself an attributed variable, or may contain attributed variables. The
257goal <tt>verify_attributes/3</tt> is actually called before _Var_ is
258unified with _Value_.
259
260It is up to the user to define which actions may be performed by
261<tt>verify_attributes/3</tt> but the procedure is expected to return in
262 _Goals_ a list of goals to be called <em>after</em> _Var_ is
263unified with _Value_. If <tt>verify_attributes/3</tt> fails, the
264unification will fail.
265
266Notice that the <tt>verify_attributes/3</tt> may be called even if _Var_<
267has no attributes in module <tt>Module</tt>. In this case the routine should
268simply succeed with _Goals_ unified with the empty list.
269
270
271*/
272do_verify_attributes([], _, _, []).
273do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :-
274 current_predicate(verify_attributes,Mod:verify_attributes(_,_,_)), current_predicate,
275 Mod:verify_attributes(AttVar, Binding, Goal),
276 do_verify_attributes(Mods, AttVar, Binding, Goals).
277do_verify_attributes([_|Mods], AttVar, Binding, Goals) :-
278 do_verify_attributes(Mods, AttVar, Binding, Goals).
279
280/**
281 @}
282*/
283
current_predicate/2
current_predicate( A, P)
sort/2
sort(+ L,- S)
source_module/1
source_module(-Mod)
throw/1
throw(+ Ball)
assert/1
assert(+ C)
assertz/1
assertz(+ C)
retract/1
retract(+ C)
use_module/1
use_module( +Files )
goal_expansion/3
goal_expansion( :G,+ M,- NG)
term_expansion/2
term_expansion( T,- X)
arg/3
arg(+ N,+ T, A)
atom/1
atom( T)
functor/3
functor( T, F, N)
var/1
var( T)
member/2
member(?Element, ?Set) is true when Set is a list, and Element occurs in it