1/* For SWI-Prolog 2 Author: Douglas R. Miles 3 E-mail: logicmoo@gmail.com 4 WWW: http://www.prologmoo.com 5 Copyright (C): 2015, University of Amsterdam 6 VU University Amsterdam 7 This program is free software; you can redistribute it and/or 8 modify it under the terms of the GNU General Public License 9 as published by the Free Software Foundation; either version 2 10 of the License, or (at your option) any later version. 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 You should have received a copy of the GNU General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 As a special exception, if you link this library with other files, 19 compiled with a Free Software compiler, to produce an executable, this 20 library does not by itself cause the resulting executable to be covered 21 by the GNU General Public License. This exception does not however 22 invalidate any other reasons why the executable file might be covered by 23 the GNU General Public License. 24*/ 25:- module(attributes, [ 26 'attribute'/1,get_atts/2,put_atts/2, 27 set_dict_atts_reader/1, 28 dict_to_attvar/2,dict_to_attvar/3, 29 op(1150, fx, 'attribute')]). 30 31:- meta_predicate('attribute'()). 32:- meta_predicate(get_atts(,)). 33:- meta_predicate(put_atts(,)). 34%:- meta_predicate(dict_to_attvar(:,?)). 35 36:- use_module(library(ordsets)). 37 38% auto-define attributes otherwise signal error is undeclared attributes are used 39:- create_prolog_flag(atts_declared,auto,[type(atom),keep(true)]). 40% Users might need to read docs to decided they rather have auto? 41:- set_prolog_flag(atts_declared,true). 42% What is all this fuss about? 43% We need some answer to what happens when ?- user:put_atts(Var,+a(1)). 44% if attibute a/1 is declared in one module at least we have some sense 45% Still doesnt solve the problem when if a/1 is declared in several modules 46% Should we use the import_module/2 Dag? 47% Still doesnt solve the problem when if a/1 is declared only in one unseen module! 48% Though every option is simple to implement, it should be left to programmers to decide with flags/options 49% and not left just to those editing these files. Still we need to pick a default. 50 51 52:- dynamic protobute/1.
where each AttributeSpec has the form Functor/Arity. Having declared some attribute names, these attributes can be added, updated and deleted from unbound variables using the following two predicates (get_atts/2 and put_atts/2) defined in the module atts. For each declared attribute name, any variable can have at most one such attribute (initially it has none).
63'attribute'(M:V):- new_attribute(V,M),!. 64 65new_attribute(V,M) :- var(V), !, throw(error(instantiation_error,'attribute'(M:V))). 66new_attribute(Na/Ar,Mod) :- !, functor(At,Na,Ar),new_attribute(At,Mod). 67new_attribute(Mod:ANY,_) :- !, new_attribute(ANY,Mod). 68new_attribute([],_). 69new_attribute((At1,At2),M) :- new_attribute(At1,M), new_attribute(At2,M). 70new_attribute([At1|At2],M) :- new_attribute(At1,M), new_attribute(At2,M). 71:- if(prolog_flag(attvar_pn,true)). 72new_attribute(At,Mod) :- dynamic(Mod:protobute/3), 73 (Mod:protobute(Mod,At,_) -> true; 74 ((Mod:protobute(Mod,_,Nth)->Nth2 is Nth+1;Nth2=1),asserta(Mod:protobute(Mod,At,Nth2)))). 75:- else. 76new_attribute(Na/Ar,Mod) :- functor(At,Na,Ar), (protobute(Mod:At) -> true; assertz(protobute(Mod:At))). 77new_attribute(Mod:ANY,_) :- new_attribute(ANY,Mod). 78new_attribute(At,Mod) :- (protobute(Mod:At) -> true; assertz(protobute(Mod:At))). 79:- endif.
Non-variable terms in Var cause a type error.
if curent_prolog_flag(atts_compat,xsb).
The effect of put_atts/2 are undone on backtracking. (prefix + may be dropped for convenience). The prefixes of AccessSpec have the following meaning: +(Attribute): The corresponding actual attribute is set to Attribute. If the actual attribute was already present, it is simply replaced. -(Attribute): The corresponding actual attribute is removed. If the actual attribute is already absent, nothing happens.
Should we ignore The arguments of Attribute, only the name and arity are relevant? Currently coded to
==
?- m1:put_atts(Var,+a(x1,y1)).
put_attr(Var, m1, [a(x1, y1)]).
?- m1:put_atts(V,+a(x1,y1)),m1:put_atts(V,+b(x1,y1)),m1:put_atts(V,-a(_,_)),m2:put_atts(V,+b(x2,y2)).
put_attr(V, m1, [b(x1, y1)]),
put_attr(V, m2, [b(x2, y2)]) .
106put_atts(Var,M:Atts):- put_atts(Var,M,Atts).
Non-variable terms in Var cause a type error.
if curent_prolog_flag(atts_compat,xsb).
AccessSpec is either +(Attribute), -(Attribute), or a list of such (prefix + may be dropped for convenience).
The prefixes in the AccessSpec have the following meaning: +(Attribute): The corresponding actual attribute must be present and is unified with Attribute. -(Attribute): The corresponding actual attribute must be absent.
Should we ignore The arguments of Attribute are ignored, only the name and arity are relevant? yes = XSB_compat, no = less control and perf
?- m1:put_atts(Var,+a(x1,y1)),m1:get_atts(Var,-missing(x1,y1)). put_attr(Var, m1, [a(x1, y1)]). ?- m1:put_atts(Var,+a(x1,y1)),m1:get_atts(Var,X). X=[a(x1, y1)], put_attr(Var, m1, [a(x1, y1)]).
TODO/QUESTION user:get_atts(Var,Atts) -> ??? only attributes in 'user' or all attributes??? Attr=[m1:...]
138get_atts(Var,M:Atts):- get_atts(Var,M,Atts). 139 140 141atts_exist(_A,_At):- current_prolog_flag(atts_declared,auto),!. 142atts_exist(_A,_At):- current_prolog_flag(dict_atts_reader,true),!. 143atts_exist(M,At):- \+ \+ (M:dynamic(protobute/3),assertion(M:protobute(M,At,_))). 144 145atts_module(Var,M):- get_attr(Var,M,Was)->assertion(is_list(Was));put_attr(Var,M,[]). 146 147atts_tmpl(At,Tmpl):-functor(At,F,A),functor(Tmpl,F,A). 148 149to_pind(unify,=(_,_)). 150to_pind(FA,PI):- compound(FA),compound_name_arity(FA,F,0),to_pind(F,PI),!. 151to_pind(F/A,PI):- atom(F),integer(A),A>0,compound_name_arity(PI,F,A). 152to_pind(F,PI):- atom(F),current_predicate( F /A),!,functor(PI,F,A). 153to_pind(PI,PI). 154 155atts_modulize([], _) --> []. 156atts_modulize([G|Gs], M) --> !, 157 atts_modulize(G, M), 158 atts_modulize(Gs, M). 159atts_modulize(G,M)--> 160 {strip_module(G,_,GS), 161 (G == GS -> MG = M:G ; MG = G)}, 162 [MG]. 163 164 165 166attrs_to_atts([])--> []. 167attrs_to_atts(att(M,Att,Rest))--> 168 atts_modulize(Att,M), 169 attrs_to_atts(Rest). 170 171% ?- put_atts(X,+(unify=write)),!. 172 173add_attr(Var,N,Value):-get_attrs(Var,Was)->put_attrs(Var,att(N,Value,Was));put_attrs(Var,att(N,Value,[])). 174 175 176% Should 'user' use the import_module/2 Dag? (curretly will just return all) 177get_atts(Var,user,Atts):-var(Atts),!,get_attrs(Var,Attr),attrs_to_atts(Attr,Atts,[]). 178% get_atts(Var,M,At):-var(At),!,get_attr(Var,M,At). 179get_atts(Var,M,List):-is_list(List),!,maplist(get_atts(Var,M),List). 180get_atts(Var,M,+At):- !,get_atts(M,Var,At). 181get_atts(Var,_,-(M:At)):- !,get_atts(Var,M,-At). 182get_atts(Var,_, (M:At)):- !,get_atts(Var,M,At). 183%get_atts(Var,_,-(M:At)):- \+ meta_handler_name(M), !,get_atts(Var,M,-At). 184%get_atts(Var,_, (M:At)):- \+ meta_handler_name(M), !,get_atts(Var,M,At). 185get_atts(Var,M, - Pair):-!, 186 atts_to_att(Pair,At), 187 atts_exist(M,At), 188 (get_attr(Var,M,Cur)-> 189 \+ memberchk(At,Cur) ; 190 true). 191get_atts(Var,M,Pair):- 192 atts_to_att(Pair,At), 193 atts_exist(M,At), 194 (get_attr(Var,M,Cur)-> 195 memberchk(At,Cur) ; 196 fail). 197 198 199put_atts(Var,M,List):- prolog_flag(attvar_pn,true),!,put_atts(+,Var,M,List). 200put_atts(_,M,At):-var(At),!,throw(error(instantiation_error,put_atts(M:At))). 201put_atts(Var,M,List):-is_list(List),!,atts_module(Var,M),maplist(put_atts(Var,M),List). 202put_atts(Var,M,+At):- !,put_atts(Var,M,At). 203put_atts(Var,_,-(M:At)):- !,put_atts(Var,M,-At). 204put_atts(Var,_, (M:At)):- !,put_atts(Var,M,At). 205 206put_atts(Var,M,-Pair):-!, 207 atts_to_att(Pair,Tmpl), 208 atts_exist(M,Tmpl), 209 (get_attr(Var,M,Cur)-> 210 (delete(Cur,Tmpl,Upd),put_attr(Var,M,Upd)) ; 211 true). 212put_atts(Var,M,Pair):- 213 atts_to_att(Pair,At), 214 atts_exist(M,At), 215 (get_attr(Var,M,Cur) -> 216 (atts_tmpl(At,Tmpl), 217 delete(Cur,Tmpl,Mid), % ord_del_element wont work here because -a(_) stops short of finding a(1). 218 ord_add_element(Mid,At,Upd), 219 put_attr(Var,M,Upd)); 220 put_attr(Var,M,[At])). 221 222 223/* the +/- Interface */ 224invert_pn(+,-). 225invert_pn(-,+). 226 227put_atts(PN,Var,M,At):-var(At),!,throw(error(instantiation_error, M:put_atts(Var,PN:At))). 228%put_atts(PN,Var,user,Atts):-!, put_atts(PN,Var,tst,Atts). 229put_atts(PN,Var,M, X+Y):-!, put_atts(PN,Var,M, X),put_atts(PN,Var,M,+Y). 230put_atts(PN,Var,M, X-Y):-!, put_atts(PN,Var,M, X),put_atts(PN,Var,M,-Y). 231put_atts(PN,Var,M, +X+Y):-!, put_atts(PN,Var,M, +X),put_atts(PN,Var,M,+Y). 232put_atts(PN,Var,M, +X-Y):-!, put_atts(PN,Var,M, +X),put_atts(PN,Var,M,-Y). 233put_atts(PN,Var,M, List):- is_list(List),!,atts_module(Var,M),maplist(put_atts(PN,Var,M),List). 234put_atts(_, Var,M, +At):-!, put_atts(+,Var,M,At). 235put_atts(PN,Var,M, -At):- invert_pn(PN,NP),!,put_atts(NP,Var,M,At). 236%put_atts(PN,Var,_,(M:At)):- \+ meta_handler_name(M), !,put_atts(PN,Var,M,At). 237%put_atts(PN,Var,M, Meta):- \+ \+ clause(M:meta_hook(Meta,_,_),_), !, forall(M:meta_hook(Meta,P,A),put_atts(PN,Var,M,P=A)). 238% =(+a,b) --> +(A=B). 239put_atts(PN,Var,M, Pair):- compound(Pair),Pair=..[P,Arg1,Arg2],attsep(P),compound(Arg1),call((Arg1=..List,append(Head,[Last],List),At=..[P,Last,Arg2],append(Head,[At],ListNew),Try=..ListNew,!,put_atts(PN,Var,M, Try))). 240% put_atts(PN,Var,_, Hook):- handler_fbs(+ Hook,Number), Number>0, !,PNHook=..[PN,Hook], put_datts(Var, PNHook). 241 242put_atts(PN,Var,M,Pair):- !, 243 atts_to_att(Pair,Tmpl), 244 % update_hooks(PN,Var,M,Tmpl), 245 atts_exist(PN,Tmpl), 246 exec_atts_put(PN,Var,M,Tmpl). 247 248 249 250exec_atts_put(-,Var,M,Tmpl):- 251 (get_attr(Var,M,Cur)-> 252 (delete(Cur,Tmpl,Upd),put_attr(Var,M,Upd)) ; 253 true). 254 255exec_atts_put(+,Var,M,At):- 256 (get_attr(Var,M,Cur) -> 257 (atts_tmpl(At,Tmpl), 258 delete(Cur,Tmpl,Mid), % ord_del_element wont work here because -a(_) stops short of finding a(1). 259 ord_add_element(Mid,At,Upd), 260 put_attr(Var,M,Upd)); 261 put_attr(Var,M,[At])). 262 263attsep('='). 264attsep(':'). 265attsep('-'). 266 267atts_to_att(Var,Var):-var(Var),!. 268atts_to_att(N-V,Tmpl):-!,atts_to_att(N=V,Tmpl). 269atts_to_att(N:V,Tmpl):-!,atts_to_att(N=V,Tmpl). 270atts_to_att(N=V,Tmpl):-!,assertion(atom(N)),!,Tmpl=..[N,V]. 271atts_to_att(F/A,Tmpl):-!,assertion((atom(F),integer(A))),functor(Tmpl,F,A). 272atts_to_att(Tmpl,Tmpl). 273 274 275 276% This type-checking predicate succeeds iff its argument is an ordinary free variable, it fails if it is an attributed variable. 277eclipsefree(X):-var(X), \+attvar(X). 278 279% This type-checking predicate succeeds iff its argument is an attributed variable. For other type testing predicates an attributed variable behaves like a variable. 280eclipsemeta(X):- attvar(X). 281 282% A new attribute can be added to a variable using the tool predicate 283% add_attribute(Var, Attr). 284% An attribute whose name is not the current module name can be added using add_attribute/3 which is its tool body predicate (exported in sepia_kernel). If Var is a free variable, it will be bound to a new attributed variable whose attribute corresponding to the current module is Attr and all its other attributes are free variables. If Var is already an attributed variable and its attribute is uninstantiated, it will b 285 286:- meta_predicate(add_attribute(,)). 287add_attribute(Var, M:Attr):- put_atts(Var,M, Attr). 288add_attribute(Var,M,Attr):- put_atts(Var,M, Attr). 289 290:- meta_predicate(get_attribute(,)). 291get_attribute(Var, M:Attr):- get_atts(Var,M, Attr). 292get_attribute(Var, M, Attr):- get_atts(Var,M, Attr). 293 294 295 296/* 297 298where Attr is the value obtained from the handler. If there are several handled attributes, all attributes are qualified like in 299X{a:A, b:B, c:C}. 300pl_notrace(_) 301*/ 302 303set_dict_atts_reader(X):- set_prolog_flag(dict_atts_reader,X). 304 305attvar_to_dict(AttVar,Dict):- 306 get_attrs(AttVar,Att3s), 307 attrs_to_pairs(Att3s,DictPairs), 308 dict_create(Dict,AttVar,DictPairs). 309 310attrs_to_pairs(att(N,V,Att3s),[N=V|DictPairs]):-!,attrs_to_pairs(Att3s,DictPairs). 311attrs_to_pairs(DictPairs,DictPairs). 312 313% dict_to_attvar(Dict):- dict_to_attvar(Dict,_),!. 314 315:- meta_predicate(dict_to_attvar(,)). 316 317dict_to_attvar(Mod:Dict,Out):-!, 318 dict_to_attvar(Mod,Dict,Out). 319dict_to_attvar(Dict,Out):- 320 '$current_source_module'(Mod), 321 dict_to_attvar(Mod,Dict,Out). 322 323dict_to_attvar(_,Dict,Out):- \+ compound(Dict),!,Out=Dict. 324dict_to_attvar(Mod,Dict,Out):- 325 is_dict(Dict),dict_pairs(Dict,M,Pairs), 326 (atom(M)->put_atts(Out,M,Pairs); 327 (var(M)-> (M=Out,put_atts(Out,Mod:Pairs)))),!. 328dict_to_attvar(Mod,Dict,Out):- 329 compound_name_arguments(Dict,F,Args), 330 maplist(dict_to_attvar(Mod),Args,ArgsO),!, 331 compound_name_arguments(Out,F,ArgsO). 332 333 334 335:- multifile(term_expansion/2). 336:- dynamic(term_expansion/2). 337:- module_transparent(term_expansion/2). 338term_expansion(Dict,X):- current_prolog_flag(dict_atts_reader,true),'$current_source_module'(M),dict_to_attvar(M,Dict,X). 339 340:- multifile(system:goal_expansion/2). 341:- dynamic(system:goal_expansion/2). 342:- module_transparent(system:goal_expansion/2). 343systemgoal_expansion(Dict,X):- current_prolog_flag(dict_atts_reader,true),'$current_source_module'(M),dict_to_attvar(M,Dict,X). 344 345:- set_prolog_flag(atts_declared,auto). 346% :- dict_atts_reader(true).
353:- module_transparent(atts_file_predicates_are_transparent/0). 354atts_file_predicates_are_transparent:- 355 source_location(S,_), prolog_load_context(module,LC), 356 atts_file_predicates_are_transparent(S,LC). 357 358:- module_transparent(atts_file_predicates_are_transparent/2). 359atts_file_predicates_are_transparent(S,_LC):- 360 forall(source_file(M:H,S), 361 (functor(H,F,A), 362 ignore(((\+ predicate_property(M:H,transparent), module_transparent(M:F/A), 363 \+ atom_concat('__aux',_,F),debug(modules,'~N:- module_transparent((~q)/~q).~n',[F,A])))))). 364 365:- 366 atts_file_predicates_are_transparent.