git.barrelfish.org Git - barrelfish/blob - 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).