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