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.
 attribute(+AttributeSpec)
:- attribute AttributeSpec,..., AttributeSpec.

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.
 put_atts(+Var, +AccessSpec)
Sets the attributes of Var according to AccessSpec.

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).
 get_atts(+Var, ?AccessSpec)
Gets the attributes of Var according to AccessSpec. If AccessSpec is unbound, it will be bound to a list of all set attributes of Var.

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.
  277eclipse:free(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.
  280eclipse:meta(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).  343system:goal_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).
All Module Predicates Are Transparent.
  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.