25
26:- module(udt, [oo/1,oo/2,is_oo/1,oo_call/3,jpl_call/3,oo_deref/2]). 27
29
30:- use_module(atts). 31:- use_module(metavar). 32
33oo(O):-metavar(O).
34oo(O,Value):-metavar(O),put_attr(O,oo,binding(O,Value)).
35oo:attr_unify_hook(B,Value):- B = binding(_Var,Prev),Prev.equals(Value).
36
37
38oo_set(UDT,Key, Value):- attvar(UDT),!,put_attr(UDT,Key, Value).
39oo_set(UDT,Key, Value):- jpl_set(UDT,Key,Value).
40
41
42
43put_oo(Key, UDT, Value, NewUDT):- is_dict(UDT),!,put_dict(Key, UDT, Value, NewUDT).
44put_oo(Key, UDT, Value, NewUDT):- oo_copy_term(UDT,NewUDT),put_oo(NewUDT,Key, Value).
45
46
47oo_copy_term(UDT,NewUDT):- copy_term(UDT,NewUDT).
48
49put_oo(Key, UDT, Value):- is_dict(UDT),!,put_dict(Key, UDT, Value).
50put_oo(Key, UDT, Value):- oo_set(UDT,Key, Value).
51
52
53get_oo(Key, UDT, Value):- oo_call(UDT,Key, Value).
54
55
56:- meta_predicate fail_on_missing(0). 57fail_on_missing(G):-catch(G,error(existence_error(_,_),_),fail).
58
59jpl_call(A,B,C):- B=..[H|L], fail_on_missing(jpl_call(A,H,L,C)),!.
60jpl_call(A,B,C):- jpl_get(A,B,C).
61
62
63
64is_oo(O):- (attvar(O);is_dict(O);jpl_is_ref(O)),!.
66
68oo_call(Self,Memb,Value):- is_dict(Self) ,!, '$dict_dot3'(Self, Memb, Value).
69oo_call(Self,Memb,Value):- attvar(Self),!,oo_call_av(Self,Memb,Value).
70oo_call(Self,Memb,Value):- compound(Self),!,oo_call_cmp(Self,Memb,Value).
71oo_call(Self,Memb,Value):- oo_deref(Self,NewSelf),!,
72 (NewSelf\=Self->
73 oo_call(NewSelf,Memb,Value);
74 Value = [Memb,Self]).
75
76oo_call_av(Self,Memb,Value):- get_attr(Self, Memb, Value),!.
77oo_call_av(Self,Memb,Value):- get_attr(Self, oo, NewSelf),!,oo_call(NewSelf,Memb,Value).
78
79oo_call_cmp(Self,Memb,Value):- jpl_is_ref(Self),!, jpl_call(Self, Memb, Value).
82oo_call_cmp(Self,Memb,Value):- oo_deref(Self,NewSelf),!, NewSelf\=Self, oo_call(NewSelf,Memb,Value).
83
84
85oo_deref(Obj,RObj):- var(Obj),!,once(get_attr(Obj,oo,binding(_,RObj));Obj=RObj),!.
86oo_deref(GVar,Value):- atom(GVar),nb_current(GVar,ValueM),!,oo_deref(ValueM,Value).
87oo_deref(Value,Value):- \+ compound(Value),!.
88oo_deref(cl_eval(Call),Result):-is_list(Call),!,cl_eval(Call,Result).
89oo_deref(cl_eval(Call),Result):-!,nonvar(Call),oo_deref(Call,CallE),!,call(CallE,Result).
90oo_deref(Value,Value):- jpl_is_ref(Value),!.
93oo_deref(Head,HeadE):- Head=..B,maplist(oo_deref,B,A),HeadE=..A,!.
94oo_deref(Value,Value).
95
96
97'$dict_dot3'(Data, Func, Value) :-
98 ( '$get_dict_ex'(Func, Data, V0)
99 *-> Value = V0
100 ; is_dict(Data, Tag)
101 -> '$dicts':eval_dict_function(Func, Tag, Data, Value)
102 ; is_list(Data)
103 -> ( (atomic(Func) ; var(Func))
104 -> dict_create(Dict, _, Data),
105 '$get_dict_ex'(Func, Dict, Value)
106 ; '$type_error'(atom, Func)
107 )
108 ; '$type_error'(dict, Data)
109 ).
110
111
112
113:-redefine_system_predicate('system':'.'(_Data, _Func, _Value)). 114:-'system':abolish('$dicts':'.'/3). 115'system':'.'(Data, Func, Value) :- !,oo_call(Data,Func,Value).
116
117
118:-listing(('.')/3). 119
120
121
122get_oo(Key, Dict, Value, NewDict, NewDict) :- is_dict(Dict),!,
123 get_dict(Key, Dict, Value, NewDict, NewDict).
124get_oo(Key, Dict, Value, NewDict, NewDict) :-
125 get_oo(Key, Dict, Value),
126 put_oo(Key, Dict, NewDict, NewDict).
138eval_oo_function(Func, Tag, UDT, Value) :- is_dict(Tag),!,
139 '$dicts':eval_dict_function(Func, Tag, UDT, Value).
140
141eval_oo_function(get(Key), _, UDT, Value) :-
142 !,
143 get_oo(Key, UDT, Value).
144eval_oo_function(put(Key, Value), _, UDT, NewUDT) :-
145 !,
146 ( atomic(Key)
147 -> put_oo(Key, UDT, Value, NewUDT)
148 ; put_oo_path(Key, UDT, Value, NewUDT)
149 ).
150eval_oo_function(put(New), _, UDT, NewUDT) :-
151 !,
152 put_oo(New, UDT, NewUDT).
153eval_oo_function(Func, Tag, UDT, Value) :-
154 call(Tag:Func, UDT, Value).
162put_oo_path(Key, UDT, Value, NewUDT) :-
163 atom(Key),
164 !,
165 put_oo(Key, UDT, Value, NewUDT).
166put_oo_path(Path, UDT, Value, NewUDT) :-
167 get_oo_path(Path, UDT, _Old, NewUDT, Value).
168
169get_oo_path(Path, _, _, _, _) :-
170 var(Path),
171 !,
172 '$instantiation_error'(Path).
173get_oo_path(Path/Key, UDT, Old, NewUDT, New) :-
174 !,
175 get_oo_path(Path, UDT, OldD, NewUDT, NewD),
176 ( get_oo(Key, OldD, Old, NewD, New),
177 is_oo(Old)
178 -> true
179 ; Old = _{},
180 put_oo(Key, OldD, New, NewD)
181 ).
182get_oo_path(Key, UDT, Old, NewUDT, New) :-
183 get_oo(Key, UDT, Old, NewUDT, New),
184 is_oo(Old),
185 !.
186get_oo_path(Key, UDT, _{}, NewUDT, New) :-
187 put_oo(Key, UDT, New, NewUDT)