Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rdfcache/repository-cache.lisp

KindCoveredAll%
expression0642 0.0
branch048 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 
6
 
7
 (defparameter *cache-dimensions* '(?::|s| ?::|p| ?::|o|))
8
 
9
 (defgeneric read-test-graph (source &key graph)
10
   (:documentation "Read triples ffrom an n3 source and return them as a list.
11
     Binds the operators to intern literal and uri and to construct statements to implementation
12
     which use the spocq model. Relies on n3:read, which reads text files directly and
13
     uses a pipe from rapper to read rdf+xml, turtle sources.")
14
   
15
   (:method :around ((source t) &key graph)
16
            (let ((n3::*intern-literal* #'(lambda (string datatype language)
17
                                            (cond (datatype
18
                                                   (intern-literal string datatype))
19
                                                  (language
20
                                                   (intern-plain-literal string language))
21
                                                  (t
22
                                                   string))))
23
                  (n3::*intern-resource* #'intern-iri)
24
                  (n3::*construct-statement* #'(lambda (s p o) (list s p o graph))))
25
              (call-next-method)))
26
   (:method ((source string) &rest args)
27
     (declare (ignore args))
28
     (with-input-from-string (stream source)
29
       (let ((result ()))
30
         (loop (let ((stmt (n3:read stream nil nil)))
31
                 (unless stmt (return))
32
                 (push stmt result)))
33
         (make-symbolic-solution-field :dimensions *cache-dimensions*
34
                              :solutions (reverse result)))))
35
   (:method ((source pathname) &rest args)
36
     (declare (ignore args))
37
     (make-symbolic-solution-field :dimensions *cache-dimensions*
38
                                   :solutions (collect-list (collect)
39
                                                (de.setf.rdf:project-graph source #'collect)))))
40
 
41
 
42
 (eval-when (:load-toplevel :compile-toplevel :execute)
43
   (unless (fboundp 'triple-graph)
44
     (defgeneric triple-graph (statement)
45
       (:method ((stmt triple)) '|rdf|:|nil|)
46
       (:method ((stmt quad)) (quad-graph stmt)))))
47
 
48
 (defun find-test-repository (location)
49
   "Return the dataset from the given location. The initial request reads and caches the dataset in
50
  *test-dataset-cache* Successive calls retrieve the initial cached copy."
51
 
52
   (or (get-registry location *repositories*)
53
       (let ((term-list (read-test-graph location)))
54
         (setf (get-registry location *repositories*)
55
               (make-instance (if (> (length term-list) 100) 'indexed-repository-cache 'sequential-repository-cache)
56
                 :id location
57
                 :statements term-list)))))
58
 
59
 (defun (setf find-test-repository) (dataset location)
60
   (if dataset
61
     (setf (gethash location *repositories*) dataset)
62
     (remhash location *repositories*))
63
   dataset)
64
 
65
 
66
 ;;; sequential cache implementation
67
 
68
 (defmethod de.setf.resource:add-statement* ((db sequential-repository-cache) subject predicate object graph)
69
   (let ((stmt (make-quad :subject subject :predicate predicate :object object :graph graph))
70
         (statements (cache-statements db)))
71
     (cond ((find stmt statements :test #'equalp))
72
           (t
73
            (setf (cache-statements db) (cons stmt statements))))))
74
 
75
 (defmethod de.setf.resource:map-statements* (continuation (db sequential-repository-cache) subject predicate object graph)
76
   "The no-index repository just iterates over the statement list."
77
   (dolist (stmt (cache-statements db))
78
     (when (and (or (null subject) (spocq.e:equal (triple-subject stmt) subject))
79
                (or (null predicate) (spocq.e:equal (triple-predicate stmt) predicate))
80
                (or (null object) (spocq.e:equal (triple-object stmt) object))
81
                (or (null graph) (spocq.e:equal (triple-graph stmt) graph)))
82
       (funcall continuation stmt))))
83
 
84
 
85
 ;;; hash cache implementation
86
 
87
 (defmacro spoc-case ((subject predicate object context)
88
                      &key spoc spo (spo- spo) spc (sp-c spc) sp (sp-- sp)
89
                      soc (s-oc soc) so (s-o- so) sc (s--c sc) s (s--- s)
90
                      poc (-poc poc) po (-po- po) pc (-p-c pc) p (-p-- p)
91
                      oc (--oc oc) o (--o- o) c (---c c) all (---- all))
92
   "Consists of a sequence of forms, each identified by a combination of statement components.
93
  The arguments are a mediator, s sequence of constituent variable and a matching series of
94
  constituent forms. If the mediator is not the constant nil, the variables are bound to the respective
95
  repository value. If nil, to the forms direct value. Then that clause is evaluated which indicates the
96
  non-null constituents. if no constituent is present, control passes to the :---- clause."
97
 
98
   `(let ((.flags. (logior (if ,subject #b1000 0) (if ,predicate #b0100 0) (if ,object #b0010 0) (if ,context #b0001 0))))
99
      (ecase .flags.
100
        (#b1111 ,spoc)
101
        (#b1110 ,spo-)
102
        (#b1101 ,sp-c)
103
        (#b1100 ,sp--)
104
        (#b1011 ,s-oc)
105
        (#b1010 ,s-o-)
106
        (#b1001 ,s--c)
107
        (#b1000 ,s---)
108
        (#b0111 ,-poc)
109
        (#b0110 ,-po-)
110
        (#b0101 ,-p-c)
111
        (#b0100 ,-p--)
112
        (#b0011 ,--oc)
113
        (#b0010 ,--o-)
114
        (#b0001 ,---c)
115
        (#b0000 ,----))))
116
 
117
 (defmethod de.setf.resource:add-statement* ((db indexed-repository-cache) subject predicate object graph)
118
   (let ((stmt (make-quad :subject subject :predicate predicate :object object :graph graph)))
119
     (flet ((index-statement (stmt hash key1 &optional key2)
120
              (if key2
121
                (let ((key1-hash (or (gethash key1 hash) (setf (gethash key1 hash) (make-repository-index)))))
122
                  (push stmt (gethash key2 key1-hash)))
123
                (push stmt (gethash key1 hash)))))
124
       (cond ((gethash stmt (cache-statements db)))
125
             (t
126
              (index-statement stmt (cache-index-ps db) predicate subject)
127
              (index-statement stmt (cache-index-po db) predicate object)
128
              (index-statement stmt (cache-index-s db) subject)
129
              (index-statement stmt (cache-index-p db) predicate)
130
              (index-statement stmt (cache-index-o db) object)
131
              (index-statement stmt (cache-index-c db) graph))))))
132
 
133
 (defmethod de.setf.resource:map-statements* (continuation (db indexed-repository-cache) subject predicate object graph)
134
   "The indexed repository tries to focus iteration over the respective index.
135
  The indices are at three level, so the context constrain requires a test against the
136
  matched statements' sources."
137
   (declare (dynamic-extent continuation))
138
   (let ((count 0))
139
     (labels ((filter-statements-by-object-by-graph (statements)
140
                (dolist (statement statements)
141
                  (when (and (spocq.e::equal (triple-object statement) object)
142
                             (spocq.e::equal (triple-graph statement) graph))
143
                    (incf count)
144
                    (funcall continuation statement))))
145
              (filter-statements-by-object (statements)
146
                (dolist (statement statements)
147
                  (when (spocq.e::equal (triple-object statement) object)
148
                    (incf count)
149
                    (funcall continuation statement))))
150
              (filter-statements-by-graph (statements)
151
                (dolist (statement statements)
152
                  (when (spocq.e::equal (triple-graph statement) graph)
153
                    (incf count)
154
                    (funcall continuation statement))))
155
              (map-list (statements)
156
                (incf count (length statements))
157
                (map nil continuation statements))
158
              (map-index (statements)
159
                (loop for stmt being each hash-key of statements
160
                      do (incf count) (funcall continuation stmt)))
161
              (gethash-if (key hash)
162
                (when hash (gethash key hash))))
163
       
164
       (spoc-case (subject predicate object graph)
165
         :spoc (filter-statements-by-object-by-graph (gethash-if subject (gethash (cache-index-ps db) predicate)))
166
         :spo  (filter-statements-by-object (gethash-if subject (gethash predicate (cache-index-ps db))))
167
         :spc  (filter-statements-by-graph (gethash-if subject (gethash predicate (cache-index-ps db))))
168
         :sp   (map-list (gethash-if subject (gethash predicate (cache-index-ps db))))
169
         :soc  (filter-statements-by-object-by-graph (gethash subject (cache-index-s db)))
170
         :so   (filter-statements-by-object (gethash subject (cache-index-s db)))
171
         :sc   (filter-statements-by-graph (gethash subject (cache-index-s db)))
172
         :s    (map-list (gethash subject (cache-index-s db)))
173
         :poc  (filter-statements-by-graph (gethash-if object (gethash predicate (cache-index-po db))))
174
         :po   (map-list (gethash-if object (gethash predicate (cache-index-po db))))
175
         :pc   (filter-statements-by-graph (gethash predicate (cache-index-p db)))
176
         :p    (map-list (gethash predicate (cache-index-p db)))
177
         :oc   (filter-statements-by-graph (gethash object (cache-index-o db)))
178
         :o    (map-list (gethash object (cache-index-o db)))
179
         :c    (map-list (gethash graph (cache-index-c db)))
180
         :all  (map-index (cache-statements db))))
181
     count))
182
 
183
 
184
 (defmethod de.setf.resource:add-statement* ((db numeric-repository-cache) subject predicate object graph)
185
   (let ((terms (repository-terms db)))
186
     (flet ((test-id (id)
187
              (assert (< -1 id (length terms)) ()
188
                      "Invalid term identifier: ~s." id)
189
              id))
190
       (let ((stmt (make-quad :subject (test-id subject) :predicate (test-id predicate)
191
                              :object (test-id object) :graph (test-id (or graph 0)))))
192
         (flet ((index-statement (stmt hash key1 &optional key2)
193
                  (if key2
194
                    (let ((key1-hash (or (gethash key1 hash) (setf (gethash key1 hash) (make-repository-index)))))
195
                      (push stmt (gethash key2 key1-hash)))
196
                    (push stmt (gethash key1 hash)))))
197
           (cond ((gethash stmt (cache-statements db)))
198
                 (t
199
                  (index-statement stmt (cache-index-ps db) predicate subject)
200
                  (index-statement stmt (cache-index-po db) predicate object)
201
                  (index-statement stmt (cache-index-s db) subject)
202
                  (index-statement stmt (cache-index-p db) predicate)
203
                  (index-statement stmt (cache-index-o db) object)
204
                  (index-statement stmt (cache-index-c db) graph))))))))
205
 
206
 (defmethod de.setf.resource:map-statements* (continuation (db numeric-repository-cache) subject predicate object graph)
207
   "The indexed repository tries to focus iteration over the respective index.
208
  The indices are at three level, so the context constrain requires a test against the
209
  matched statements' sources."
210
   (declare (dynamic-extent continuation))
211
   (let ((count 0))
212
     (labels ((filter-statements-by-object-by-graph (statements)
213
                (dolist (statement statements)
214
                  (when (and (= (triple-object statement) object)
215
                             (= (triple-graph statement) graph))
216
                    (incf count)
217
                    (funcall continuation statement))))
218
              (filter-statements-by-object (statements)
219
                (dolist (statement statements)
220
                  (when (= (triple-object statement) object)
221
                    (incf count)
222
                    (funcall continuation statement))))
223
              (filter-statements-by-graph (statements)
224
                (dolist (statement statements)
225
                  (when (= (triple-graph statement) graph)
226
                    (incf count)
227
                    (funcall continuation statement))))
228
              (map-list (statements)
229
                (incf count (length statements))
230
                (map nil continuation statements))
231
              (map-index (statements)
232
                (loop for stmt being each hash-key of statements
233
                      do (incf count) (funcall continuation stmt)))
234
              (gethash-if (key hash)
235
                (when hash (gethash key hash))))
236
       
237
       (spoc-case (subject predicate object graph)
238
         :spoc (filter-statements-by-object-by-graph (gethash-if subject (gethash (cache-index-ps db) predicate)))
239
         :spo  (filter-statements-by-object (gethash-if subject (gethash predicate (cache-index-ps db))))
240
         :spc  (filter-statements-by-graph (gethash-if subject (gethash predicate (cache-index-ps db))))
241
         :sp   (map-list (gethash-if subject (gethash predicate (cache-index-ps db))))
242
         :soc  (filter-statements-by-object-by-graph (gethash subject (cache-index-s db)))
243
         :so   (filter-statements-by-object (gethash subject (cache-index-s db)))
244
         :sc   (filter-statements-by-graph (gethash subject (cache-index-s db)))
245
         :s    (map-list (gethash subject (cache-index-s db)))
246
         :poc  (filter-statements-by-graph (gethash-if object (gethash predicate (cache-index-po db))))
247
         :po   (map-list (gethash-if object (gethash predicate (cache-index-po db))))
248
         :pc   (filter-statements-by-graph (gethash predicate (cache-index-p db)))
249
         :p    (map-list (gethash predicate (cache-index-p db)))
250
         :oc   (filter-statements-by-graph (gethash object (cache-index-o db)))
251
         :o    (map-list (gethash object (cache-index-o db)))
252
         :c    (map-list (gethash graph (cache-index-c db)))
253
         :all  (map-index (cache-statements db))))
254
     count))
255
 
256
 
257
 (defgeneric solution-fields-equal (field1 field2)
258
   (:documentation "Return true iff the fields' variables agree and the respective solution sets
259
     are identical without respect to ordering. allow also for atomic boolean values")
260
 
261
   (:method ((field1 t) (field2 t))
262
     (equalp field1 field2))
263
 
264
   (:method ((field1 solution-field) (field2 solution-field))
265
     (and (equalp (solution-field-dimensions field1) (solution-field-dimensions field2))
266
          (solution-fields-equal (solution-field-solutions field1) (solution-field-solutions field2))))
267
 
268
   (:method ((field1 symbolic-solution-field) (field2 symbolic-solution-field))
269
     (and (equalp (solution-field-dimensions field1) (solution-field-dimensions field2))
270
          (solution-fields-equal (symbolic-solution-field-solutions field1) (symbolic-solution-field-solutions field2))))
271
 
272
   (:method ((field1 cons) (field2 cons))
273
     (labels ((term-equal (t1 t2)
274
                (or (equalp t1 t2)
275
                    ;; indiscriminately
276
                    (and (spocq:blank-node-p t1) (spocq:blank-node-p t2))))
277
              (solution-equal (solution1 solution2)
278
                (and (or (= (length solution1) (length solution2))
279
                         (when (and (= (length solution1) 4) (null (fourth solution1)))
280
                           (setq solution1 (subseq solution1 0 3)))
281
                         (when (and (= (length solution2) 4) (null (fourth solution2)))
282
                           (setq solution2 (subseq solution2 0 3))))
283
                     (every #'term-equal solution1 solution2))))
284
       (null (set-exclusive-or field1 field2 :test #'solution-equal))))
285
 
286
   (:method ((field1 array) (field2 array))
287
     (equalp field1 field2)))
288
   
289
 ;;;
290
 ;;; cache store matching
291
 
292
 (defgeneric cache-quad-match (statements &key subject predicate object graph context)
293
 
294
   (:method ((statements list) &key subject predicate object (graph '|rdf|:|nil|) (context graph))
295
     "Perform a simplistic match for s,p,o,g against a sequence of statements."
296
     
297
     (flet ((term-equal (t1 t2)
298
              (equal t1 t2)))
299
       (when subject
300
         (setf statements (remove subject statements :test-not #'term-equal :key #'triple-subject)))
301
       (when predicate
302
         (setf statements (remove predicate statements :test-not #'term-equal :key #'triple-predicate)))
303
       (when object
304
         (setf statements (remove object statements :test-not #'term-equal :key #'triple-object)))
305
       (when context
306
         (setf statements (remove context statements :test-not #'term-equal :key #'triple-graph)))
307
       statements))
308
 
309
   (:method ((repository repository-cache) &key subject predicate object (graph '|rdf|:|nil|) (context graph))
310
     "Perform an indexed match for s,p,o,g against dimensional statement hashes."
311
 
312
     (collect-list (collect)
313
       (de.setf.resource:map-statements* #'collect repository subject predicate object context))))