renaming defines
[barrelfish] / usr / skb / programs / objects3.pl
1 :- local store(rh).
2 :- local store(sequenceTable).
3
4 :- dynamic watch/1.
5 :- lib(lists).
6
7 % This can be enabled when external/2 and lib(regex) works correctly (don't
8 % forget to remove the stuff in skb_main.c in that case)...
9 %:- lib(regex).
10 %:- external(save_index/3, p_save_index).
11 %:- external(remove_index/3, p_remove_index).
12 %:- external(remove_index/3, p_remove_index).
13 %:- external(index_intersect/4, p_index_intersect).
14
15 %
16 % Get Record
17 %
18 get_object(Name, AList, CList, Object) :-
19     make_all_constraints(AList, CList, SConstraints),
20     (atom(Name) -> 
21         get_by_name(Name, SConstraints, Object)
22         ;
23         get_by_constraints(Name, SConstraints, Object)
24     ).
25
26 get_first_object(Name, AList, CList, Object) :-
27     make_all_constraints(AList, CList, SConstraints),
28     (atom(Name) -> 
29         get_by_name(Name, SConstraints, Object)
30         ;
31         get_by_constraints(Name, SConstraints, Object)
32     ), !.
33
34 get_by_constraints(Name, Constraints, Object) :-
35     find_candidates(Constraints, Candidate),
36     ( not var(Name) ->
37         Name = name_constraint(Value),
38         match(Value, Candidate, []) 
39     ; true ),
40     match_object(Candidate, Constraints, Object).
41
42 get_by_name(Name, Constraints, Object) :-
43     atom(Name),
44     match_object(Name, Constraints, Object).
45
46 match_object(Name, Constraints, object(Name, SList)) :-
47     store_get(rh, Name, SList),
48     match_constraints(Constraints, SList).
49
50 find_candidates(Constraints, RecordName) :-
51     length(Constraints, 0), !,
52     stored_keys(rh, AllNames),
53     iterate_candidates(AllNames, RecordName).
54 find_candidates(Constraints, RecordName) :-
55     not length(Constraints, 0), !,
56     get_index_names(Constraints, IdxList),
57     find_next_candidate(IdxList, RecordName).
58
59 find_next_candidate(AttributeList, NextItem) :-
60     index_intersect_aux(AttributeList, 0, NextItem).
61
62 % This makes our C predicate non-deterministic
63 index_intersect_aux(AttributeList, OldState, Item) :-
64     index_intersect(rh, AttributeList, OldState, NewItem),
65     (
66         Item = NewItem
67     ;
68         index_intersect_aux(AttributeList, NewItem, Item)
69     ). 
70
71 iterate_candidates([Cur|Rest], RecordName) :- 
72     (RecordName = Cur ; 
73     iterate_candidates(Rest, RecordName)).
74
75 get_index_names([], []).
76 get_index_names([Cur|CList], [Attribute|AList]) :-
77     (Cur = constraint(Attribute, _, _) ; Cur = val(Attribute, _)),
78     get_index_names(CList, AList).
79
80 make_all_constraints(AList, CList, SConstraints) :-
81     convert_attributes(AList, ACList),
82     append(ACList, CList, Constraints),
83     sort(Constraints, SConstraints). % Sorting allows us to do matching in linear time
84
85
86 %
87 % Attribute/Constraint Matching
88 %
89 string_compare(C, A, B) :-
90     atom(A), string(B), !,
91     atom_string(A, SA),
92     string_compare(C, SA, B).
93 string_compare(C, A, B) :-
94     string(A), atom(B), !,
95     atom_string(B, SB),
96     string_compare(C, A, SB).
97 string_compare('==', A, B) :- !,
98     compare(=, A, B).
99 string_compare('!=', A, B) :- !,
100     (compare(<, A, B), ! ; compare(>, A, B), !).
101 string_compare('>=', A, B) :- !,
102     (compare(>, A, B), ! ; compare(=, A, B), !).
103 string_compare('<=', A, B) :- !,
104     (compare(<, A, B), ! ; compare(=, A, B), !).
105 string_compare(C, A, B) :- !,
106     compare(C, A, B).
107
108 number_compare('==', A, B) :-
109     !, A =:= B.
110 number_compare('!=', A, B) :-
111     !, A =\= B.
112 number_compare('<=', A, B) :-
113     !, A =< B.
114 number_compare(C, A, B) :-
115     !, FX =.. [C, A, B],
116     call(FX).
117
118 match_constraints([], _).
119     
120 % Number comparison
121 match_constraints([constraint(Key, Comparator, Value)|Rest], [val(Key, SVal)|SRest]) :-
122     number(SVal), number(Value), !,
123     number_compare(Comparator, SVal, Value),
124     match_constraints(Rest, [val(Key, SVal)|SRest]).
125
126 % Regular Expression
127 match_constraints([constraint(Key, match, Value)|Rest], [val(Key, SVal)|SRest]) :-
128     !, ( (string(SVal) ; atom(SVal)), (string(Value) ; atom(Value)) ),
129     match(Value, SVal, []),
130     match_constraints(Rest, [val(Key, SVal)|SRest]).
131
132 % String comparison
133 match_constraints([constraint(Key, Comparator, Value)|Rest], [val(Key, SVal)|SRest]) :-
134     ( (string(Value) ; atom(Value)), (string(SVal) ; atom(SVal)) ), !,
135     string_compare(Comparator, SVal, Value),
136     match_constraints(Rest, [val(Key, SVal)|SRest]).
137
138 % Variable
139 match_constraints([constraint(Key, '==', Value)|Rest], [val(Key, SVal)|SRest]) :-
140     var(Value),  !,
141     Value = SVal,
142     match_constraints(Rest, [val(Key, SVal)|SRest]).
143
144 % Skip to next relevant Slot in List
145 match_constraints([constraint(AKey, Comparator, Value)|Rest], [val(SKey, SVal)|SRest]) :-
146     compare(>, AKey, SKey), !,
147     match_constraints([constraint(AKey, Comparator, Value)|Rest], SRest).
148
149 % Helper functions to convert attributes in constraint and match them against object
150 prepare_constraint(val(Key, QVal), constraint(Key, ==, QVal)).
151 convert_attributes(AList, CList) :-
152     maplist(prepare_constraint, AList, CList).
153
154
155 %
156 % Add Record
157 %
158 next_sequence(Name, Next) :-
159     store_get(sequenceTable, Name, Next),
160     !,
161     store_inc(sequenceTable, Name).
162 next_sequence(Name, 0) :-
163     store_inc(sequenceTable, Name).
164
165 add_seq_object(Name, UList, CList) :-
166     next_sequence(Name, Seq),
167     number_string(Seq, SeqStr),
168     atom_string(Name, NameStr),
169     append_strings(NameStr, SeqStr, NameSeqStr),
170     atom_string(NameSeq, NameSeqStr),
171     add_object(NameSeq, UList, CList).
172
173 add_object(Name, UList, CList) :-
174     get_object(Name, [], CList, object(Name, SList)),
175     del_attribute_index(Name, SList),
176     save_object(Name, UList), !.
177 add_object(Name, UList, CList) :-
178     length(CList, 0),
179     save_object(Name, UList).
180
181 save_object(Name, SList) :-
182     transform_attributes(SList, USList),
183     store_set(rh, Name, USList),
184     set_attribute_index(Name, USList),
185     !,
186     trigger_watches(object(Name, USList), 1),
187     print_object(object(Name, SList)).
188
189
190 transform_attributes(AList, RNDList) :-
191     sort(AList, RList),
192     filter_duplicates(RList, RNDList).
193
194 filter_duplicates([], []).
195 filter_duplicates([X], [X]) :- !.
196 filter_duplicates([val(Key, X),val(Key, Y)|Rest], Out) :-
197     filter_duplicates([val(Key, Y)|Rest], Out).
198 filter_duplicates([val(Key1, X), val(Key2, Y)|Rest], [val(Key1, X)|Out]) :-
199     Key1 \= Key2,
200     filter_duplicates([val(Key2, Y)|Rest], Out).
201
202
203 %
204 % Attribute Index
205 %
206 set_attribute_index(Name, SList) :-
207     save_index(rh, SList, Name).
208 del_attribute_index(Name, SList) :-
209     remove_index(rh, SList, Name).
210
211 %
212 % Delete Record
213 %
214 del_object(Thing, AList, CList) :-
215     get_object(Thing, AList, CList, object(Name, SList)),
216     store_delete(rh, Name),
217     !,
218     del_attribute_index(Name, SList),
219     trigger_watches(object(Name, SList), 2).
220
221 %
222 % Watches
223 %
224
225 % TODO
226 % assert/retract are really bad in terms of performance
227 % this is nothing else as a subscription, combine this with pubsub 
228 % as long as the amount of concurrent watches is small this is ok
229 set_watch(Template, Mode, Recipient) :-
230     Recipient = subscriber(Binding, Id, ReplyState, Mode),
231     Template = template(Name, AList, CList),
232     add_subscription(trigger, Id, Template, Recipient).
233
234 trigger_watches(Record, Mode) :-
235     find_watches(Record, Watches),
236     check_watches(Record, Mode, Watches).
237
238 find_watches(Record, L) :-
239     coverof(X, find_subscriber(trigger, Record, X), L), !.
240 find_watches(_, []).
241
242 check_watches(_, _, []).
243 check_watches(Record, Mode, [T|Rest]) :-
244     check_watch(Record, Mode, T),
245     check_watches(Record, Mode, Rest).
246
247 check_watch(Record, Action, subscriber(Binding, Id, ReplyState, Mode)) :-
248     Action /\ Mode > 0,
249     !,
250     format_object(Record, Output),
251     trigger_watch(Output, Action, Mode, ReplyState, Id, Retract),
252     try_retract(Retract, Id, Binding).
253 check_watch(_, _, _). % Checking watches should never fail
254
255 try_retract(1, Id, Binding) :-
256     delete_subscription(trigger, Id, Binding).
257 try_retract(0, _, _). 
258
259 remove_watch(Binding, Id) :-
260     store_get(trigger, Id, subscription(_, _, subscriber(Binding, Id, ReplyState, Mode))),
261     delete_subscription(trigger, Id, Binding),
262     trigger_watch(_, 16, 0, ReplyState, Id, _). % 16 is OCT_REMOVED
263
264 %
265 % Output
266 %
267 print_names([]) :-
268     flush(1),
269     flush(2).
270 print_names([object(X, _)]) :-
271     !,
272     write(X),
273     flush(1),
274     flush(2).
275 print_names([object(X, _)|Rest]) :-
276     write(X),
277     write(', '),
278     print_names(Rest).
279
280 print_object(X) :-
281     format_object(X, Out),
282     write(Out),
283     flush(1),
284     flush(2).
285
286 format_object(object(Thing, SlotList), O4) :-
287     atom_string(Thing, StrThing),
288     append_strings(StrThing, " { ", O2),
289     format_slots(SlotList, O2, O3),
290     !,
291     append_strings(O3, " }", O4).
292
293 format_slots([], In, Out) :-
294     append_strings(In, "", Out).
295 format_slots([S], In, Out) :-
296     format_slot(S, In, Out).
297 format_slots([S|Rest], In, Out) :-
298     format_slot(S, In, Out2),
299     append_strings(Out2, ", ", Out3),
300     format_slots(Rest, Out3, Out).
301
302 format_slot(val(Attr, X), In, Out) :-
303     atom_string(Attr, StrAttr),
304     append_strings(In, StrAttr, Out1),
305     append_strings(Out1, ": ", Out2),
306     format_slot_val(X, Out2, Out).
307
308 format_slot_val(Val, In, Out) :-
309     number(Val),
310     number_string(Val, StrVal),
311     append_strings(In, StrVal, Out).
312 format_slot_val(Val, In, Out) :-
313     atom(Val),
314     atom_string(Val, StrVal),
315     append_strings(In, StrVal, Out).
316 format_slot_val(Val, In, Out) :-
317     string(Val),
318     append_strings(In, "'", Out1),
319     append_strings(Out1, Val, Out2),
320     append_strings(Out2, "'", Out).