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