Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rlmdb/quad.lisp

KindCoveredAll%
expression126486 25.9
branch1444 31.8
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.rdf.lmdb.implementation)
4
 
5
 (:documentation "LMDB rdf quad operations."
6
                 "A QUAD object comprises a (graph x subject x predicate x object) combination,
7
  where each element is an (unsigned byte 32) term index.
8
  These are stored as the index keys in the various s-p-o-g combination indices.
9
  A retrieval involves two principle quad-related operations
10
  - permute a quad pattern for use as an index key
11
  - test (the permuted) pattern against the keys yields by a cursor scan to constrain results.
12
  see dydra-cgi:src;dydra;quad.h
13
 
14
   bool match(const quad& other) const {
15
 #if 0
16
     if (context_id() == -2) { // HACK for named-graph iteration
17
       if (other.context_id() == -1) {
18
         return false;
19
       }
20
     }
21
     else
22
 #endif
23
     if (context_id() != 0 && context_id() != other.context_id()) {
24
       return false;
25
     }
26
 
27
     if (subject_id() != 0 && subject_id() != other.subject_id()) {
28
       return false;
29
     }
30
 
31
     if (predicate_id() != 0 && predicate_id() != other.predicate_id()) {
32
       return false;
33
     }
34
 
35
     if (object_id() != 0 && object_id() != other.object_id()) {
36
       // TODO: xsd:integer and xsd:decimal rules.
37
       return false;
38
     }
39
 
40
     return true;
41
   }
42
  ")
43
 
44
 
45
 ;;; (quad-pattern-mask-index #(43851499 0 438 0))
46
 ;;; (quad-pattern-key-map-index #(43851499 0 438 0))
47
 
48
 (defun quad-match-p (test-quad pattern-quad)
49
   (and (case (spocq:quad-graph pattern-quad)
50
          (-2 (/= -1 (spocq:quad-graph test-quad)))
51
          (0 t)
52
          (t (spocq.e:= (spocq:quad-graph pattern-quad) (spocq:quad-graph test-quad))))
53
        (or (= 0 (spocq:quad-subject pattern-quad))
54
            (spocq.e:= (spocq:quad-subject pattern-quad) (spocq:quad-subject test-quad)))
55
        (or (= 0 (spocq:quad-predicate pattern-quad))
56
            (spocq.e:= (spocq:quad-predicate pattern-quad) (spocq:quad-predicate test-quad)))
57
        (or (= 0 (spocq:quad-object pattern-quad))
58
            (spocq.e:= (spocq:quad-object pattern-quad) (spocq:quad-object test-quad)))))
59
           
60
 
61
 (defun %quad-match-p (%pattern-quad %test-quad)
62
   (declare (optimize (speed 3) (safety 0)))
63
   #+(or)
64
   (format *trace-output* "~%%quad-match-p: pattern: (~s ~s ~s ~s) instance: (~s ~s ~s ~s)"
65
           (%quad-context %pattern-quad) (%quad-subject %pattern-quad) (%quad-predicate %pattern-quad) (%quad-object %pattern-quad)
66
           (%quad-context %test-quad) (%quad-subject %test-quad) (%quad-predicate %test-quad) (%quad-object %test-quad))
67
   (assert (and (cffi-sys:pointerp %pattern-quad) (cffi-sys:pointerp %test-quad)) ()
68
           "%quad-match-p: pointers are required.")
69
   (and (or (= 0 (%quad-context %pattern-quad))
70
            (= (%quad-context %pattern-quad) (%quad-context %test-quad)))
71
        (or (= 0 (%quad-subject %pattern-quad))
72
            (= (%quad-subject %pattern-quad) (%quad-subject %test-quad)))
73
        (or (= 0 (%quad-predicate %pattern-quad))
74
            (= (%quad-predicate %pattern-quad) (%quad-predicate %test-quad)))
75
        (or (= 0 (%quad-object %pattern-quad))
76
            (= (%quad-object %pattern-quad) (%quad-object %test-quad)))))
77
 
78
 (defun term-number-record-to-quad (%quad quad)
79
   (setf (spocq:quad-subject quad)
80
         (rlmdb:term-number-value (cffi:foreign-slot-value %quad '(:struct quad) 'subject))
81
         (spocq:quad-predicate quad)
82
         (rlmdb:term-number-value (cffi:foreign-slot-value %quad '(:struct quad) 'predicate))
83
         (spocq:quad-object quad)
84
         (rlmdb:term-number-value (cffi:foreign-slot-value %quad '(:struct quad) 'object))
85
         (spocq:quad-graph quad)
86
         (rlmdb:term-number-value (cffi:foreign-slot-value %quad '(:struct quad) 'context)))
87
   quad)
88
 
89
 (defun term-number-record-to-vector (%quad vector)
90
   (setf (aref vector 1)
91
         (cffi:foreign-slot-value %quad '(:struct quad) 'subject)
92
         (aref vector 2)
93
         (cffi:foreign-slot-value %quad '(:struct quad) 'predicate)
94
         (aref vector 3)
95
         (cffi:foreign-slot-value %quad '(:struct quad) 'object)
96
         (aref vector 0)
97
         (cffi:foreign-slot-value %quad '(:struct quad) 'context))
98
   vector)
99
 
100
 
101
 
102
 (defgeneric quad-to-term-number-key (quad %quad transform)
103
   (:documentation
104
       "Where the index databases vary effect sort order with a constant predicate
105
       by varing the term order, this reconstructs a quad as per the sort order map.
106
       This applies to quad indices in the rdfcache quad indix databases only.")
107
   (:method ((quad spocq:quad) %quad transform)
108
     ;; quad transform map indicates the respective source index
109
     (flet ((get-indexed-quad-slot-term-number (index)
110
              (spocq.i::rdfcache-lookup-object-term-number
111
               (ecase index
112
                 (0 (spocq:quad-graph quad))
113
                 (1 (spocq:quad-subject quad))
114
                 (2 (spocq:quad-predicate quad))
115
                 (3 (spocq:quad-object quad))))))
116
       ;;(print (list :transform transform))
117
       (dotimes (x 4)
118
         ;;(print (list x :from  (aref transform x) :is (get-indexed-quad-slot-term-number (aref transform x))))
119
         (setf (cffi:mem-aref %quad 'term-id x)
120
               (get-indexed-quad-slot-term-number (aref transform x)))))
121
     ;;(print :term-number.key)
122
     ;;(print quad)
123
     ;;(%print-quad %quad *trace-output*)
124
     %quad)
125
   (:method ((quad vector) %quad transform)
126
     (flet ((coerce-term-number (tn)
127
              (cond ((= tn -1) #xffffffff)
128
                    ((= tn -2) 0)
129
                    (t tn))))
130
       (setf (cffi:mem-aref %quad 'term-id 0)
131
             (coerce-term-number (aref quad (aref transform 0))))
132
       (setf (cffi:mem-aref %quad 'term-id 1)
133
             (coerce-term-number (aref quad (aref transform 1))))
134
       (setf (cffi:mem-aref %quad 'term-id 2)
135
             (coerce-term-number (aref quad (aref transform 2))))
136
       (setf (cffi:mem-aref %quad 'term-id 3)
137
             (coerce-term-number (aref quad (aref transform 3)))))
138
     ;; (print :term-number.key *trace-output*)
139
     ;; (print quad *trace-output*)
140
     ;; (%print-quad %quad *trace-output*)
141
     %quad))
142
 
143
 
144
 (defgeneric quad-to-quad-record (quad %quad)
145
   (:documentation "pack the  respective term numbers into the quad record.
146
    if some term is not present, return nil")
147
   (:method ((quad spocq:quad) (quad-vector vector))
148
     (flet ((term-number-or-wild (object)
149
              (if object
150
                  (or (spocq.i::rdfcache-lookup-object-term-number object)
151
                      (return-from quad-to-quad-record nil))
152
                  0)))
153
       (setf (aref quad-vector 0) (term-number-or-wild (spocq:quad-graph quad)))
154
       (setf (aref quad-vector 1) (term-number-or-wild (spocq:quad-subject quad)))
155
       (setf (aref quad-vector 2) (term-number-or-wild (spocq:quad-predicate quad)))
156
       (setf (aref quad-vector 3) (term-number-or-wild (spocq:quad-object quad)))
157
       quad-vector))
158
   (:method ((quad spocq:quad) %quad)
159
     (flet ((term-number-or-wild (object)
160
              (if object
161
                  (or (spocq.i::rdfcache-lookup-object-term-number object)
162
                      (return-from quad-to-quad-record nil))
163
                  0)))
164
       (setf (%quad-context %quad) (term-number-or-wild (spocq:quad-graph quad)))
165
       (setf (%quad-subject %quad) (term-number-or-wild (spocq:quad-subject quad)))
166
       (setf (%quad-predicate %quad) (term-number-or-wild (spocq:quad-predicate quad)))
167
       (setf (%quad-object %quad) (term-number-or-wild (spocq:quad-object quad)))
168
       %quad))
169
   (:method ((quad vector) %quad)
170
     (flet ((coerce-term-number (tn)
171
              (cond ((= tn -1) #xffffffff)
172
                    ((= tn -2) 0)
173
                    (t tn))))
174
       (setf (%quad-context %quad) (coerce-term-number (aref quad 0)))
175
       (setf (%quad-subject %quad) (coerce-term-number (aref quad 1)))
176
       (setf (%quad-predicate %quad) (coerce-term-number (aref quad 2)))
177
       (setf (%quad-object %quad) (coerce-term-number (aref quad 3)))
178
       %quad)))
179
 #+(or) ;; SHOULD RETURN NIL, NOT SIGNAL AN ERROR
180
 (cffi:with-foreign-objects ((%quad-pattern '(:struct rdfcache::quad)))
181
    (quad-to-term-number-record
182
     (spocq:make-quad :subject "one" :predicate "two" :object "three" :graph "for.")
183
     %quad-pattern))
184
 
185
 (defgeneric quad-to-tsiquad-record (quad %tsiquad)
186
   (:method ((quad spocq:quad) %tsiquad)
187
     ;; tquad transform map indicates the respective source index
188
     (flet ((term-number-or-wild (object)
189
              (if object
190
                  (or (spocq.i::rdfcache-lookup-object-term-number object)
191
                      (return-from quad-to-tsiquad-record nil))
192
                  0)))
193
       (setf (%tsiquad-context %tsiquad) (term-number-or-wild (spocq:quad-graph quad)))
194
       (setf (%tsiquad-subject %tsiquad) (term-number-or-wild (spocq:quad-subject quad)))
195
       (setf (%tsiquad-predicate %tsiquad) (term-number-or-wild (spocq:quad-predicate quad)))
196
       (setf (%tsiquad-object %tsiquad) (term-number-or-wild (spocq:quad-object quad)))
197
       %tsiquad))
198
   (:method ((quad vector) %tsiquad)
199
     (flet ((coerce-term-number (tn)
200
              (cond ((= tn -1) #xffffffff)
201
                    ((= tn -2) 0)
202
                    (t tn))))
203
       (setf (%tsiquad-context %tsiquad) (coerce-term-number (aref quad 0)))
204
       (setf (%tsiquad-subject %tsiquad) (coerce-term-number (aref quad 1)))
205
       (setf (%tsiquad-predicate %tsiquad) (coerce-term-number (aref quad 2)))
206
       (setf (%tsiquad-object %tsiquad) (coerce-term-number (aref quad 3)))
207
       ;; (print :term-number.key *trace-output*)
208
       ;; (print quad *trace-output*)
209
       ;; (%print-quad %quad *trace-output*)
210
       %tsiquad)))
211
 
212
 (defgeneric quad-to-tsoquad-record (quad %tsoquad)
213
   (:method ((quad spocq:quad) %tsoquad)
214
     ;; tsoquad transform map indicates the respective source index
215
     (flet ((term-number-or-wild (object)
216
              (if object
217
                  (or (spocq.i::rdfcache-lookup-object-term-number object)
218
                      (return-from quad-to-tsoquad-record nil))
219
                  0)))
220
       (setf (%tsoquad-context %tsoquad) (term-number-or-wild (spocq:quad-graph quad)))
221
       (setf (%tsoquad-subject %tsoquad) (term-number-or-wild (spocq:quad-subject quad)))
222
       (setf (%tsoquad-predicate %tsoquad) (term-number-or-wild (spocq:quad-predicate quad)))
223
       (setf (%tsoquad-object %tsoquad) (term-number-or-wild (spocq:quad-object quad)))
224
       %tsoquad))
225
   (:method ((quad vector) %tsoquad)
226
     (flet ((coerce-term-number (tn)
227
              (cond ((= tn -1) #xffffffff)
228
                    ((= tn -2) 0)
229
                    (t tn))))
230
       (setf (%tsoquad-context %tsoquad) (coerce-term-number (aref quad 0)))
231
       (setf (%tsoquad-subject %tsoquad) (coerce-term-number (aref quad 1)))
232
       (setf (%tsoquad-predicate %tsoquad) (coerce-term-number (aref quad 2)))
233
       (setf (%tsoquad-object %tsoquad) (coerce-term-number (aref quad 3)))
234
       %tsoquad)))
235
 
236
 (defgeneric quad-to-tstquad-record (quad %tstquad)
237
   (:method ((quad spocq:quad) %tstquad)
238
     ;; tstquad transform map indicates the respective source index
239
     (flet ((term-number-or-wild (object)
240
              (if object
241
                  (or (spocq.i::rdfcache-lookup-object-term-number object)
242
                      (return-from quad-to-tstquad-record nil))
243
                  0)))
244
       (setf (%tstquad-context %tstquad) (term-number-or-wild (spocq:quad-graph quad)))
245
       (setf (%tstquad-subject %tstquad) (term-number-or-wild (spocq:quad-subject quad)))
246
       (setf (%tstquad-predicate %tstquad) (term-number-or-wild (spocq:quad-predicate quad)))
247
       (setf (%tstquad-object %tstquad) (term-number-or-wild (spocq:quad-object quad)))
248
       %tstquad))
249
   (:method ((quad vector) %tstquad)
250
     (flet ((coerce-term-number (tn)
251
              (cond ((= tn -1) #xffffffff)
252
                    ((= tn -2) 0)
253
                    (t tn))))
254
       (setf (%tstquad-context %tstquad) (coerce-term-number (aref quad 0)))
255
       (setf (%tstquad-subject %tstquad) (coerce-term-number (aref quad 1)))
256
       (setf (%tstquad-predicate %tstquad) (coerce-term-number (aref quad 2)))
257
       (setf (%tstquad-object %tstquad) (coerce-term-number (aref quad 3)))
258
       ;; (print :term-number.key *trace-output*)
259
       ;; (print quad *trace-output*)
260
       ;; (%print-quad %quad *trace-output*)
261
       %tstquad)))
262
 
263
 (defun quad-to-tquad-record (quad %tquad)
264
   "implemented the same as -to-tstquad"
265
   (quad-to-tstquad-record quad %tquad))
266
 
267
 (defun term-number-key-to-term-number-quad (%key %quad transform)
268
   ;(print (list :term-number-key-to-term-number-quad transform) *trace-output*)
269
   (setf (cffi:mem-aref %quad 'term-id (aref transform 0)) (cffi:mem-aref %key 'term-id 0))
270
   (setf (cffi:mem-aref %quad 'term-id (aref transform 1)) (cffi:mem-aref %key 'term-id 1))
271
   (setf (cffi:mem-aref %quad 'term-id (aref transform 2)) (cffi:mem-aref %key 'term-id 2))
272
   ;(print (list (cffi:mem-aref %key 'term-id 2) (cffi:mem-aref %quad 'term-id (aref transform 2))))
273
   (setf (cffi:mem-aref %quad 'term-id (aref transform 3)) (cffi:mem-aref %key 'term-id 3))
274
   #|(format *trace-output* "~&[~s](~s ~s ~s ~s)~%"
275
           %key
276
           (cffi:mem-aref %key 'term-id 0) (cffi:mem-aref %key 'term-id 1) (cffi:mem-aref %key 'term-id 2) (cffi:mem-aref %key 'term-id 3))
277
   (%print-quad %key *trace-output*)
278
   (%print-quad %quad *trace-output*)|#
279
   %quad)
280
   
281
 
282
 #+(or)
283
 (cffi:with-foreign-object (%quad '(:struct rdfcache::quad))
284
   (%print-quad %quad *trace-output*)
285
   (dotimes (x 4) (setf (cffi:mem-aref %quad 'term-id x) x))
286
   (%print-quad %quad *trace-output*)
287
   t)
288
 
289
 (defun copy-quad-record (from to &optional (offset 0))
290
   ;;(print :from-to)
291
   ;;(%print-quad from *trace-output*)
292
   ;;(%print-quad to *trace-output*)
293
   (loop for i below 4 for j from offset
294
     do (setf (cffi:mem-aref to 'term-id j) (cffi:mem-aref from 'term-id i)))
295
   ;;(setf (%quad-subject to) (%quad-subject from))  
296
   ;;(setf (%quad-predicate to) (%quad-predicate from))
297
   ;;(setf (%quad-object to) (%quad-object from))
298
   ;;(setf (%quad-context to) (%quad-context from))
299
   ;;(%print-quad from *trace-output*)
300
   ;;(%print-quad to *trace-output*)
301
   to)
302
 
303
 (defgeneric copy-quad-pattern (from)
304
   (:method ((from spocq:quad))
305
     (spocq.i::copy-quad from))
306
   (:method ((from vector))
307
     (make-array 4 :initial-contents from)))
308
 
309
 (defgeneric copy-tquad-pattern (from)
310
   (:method ((from spocq:quad))
311
     (spocq.i::copy-tquad from))
312
   (:method ((from vector))
313
     (make-array 5 :initial-contents from)))
314
 
315
 (defun wild-term-p (term)
316
   (or (null term) (eql term 0)))
317
 
318
 
319
 ;;; (trace test-visibility)
320
 ;;; (loop for ordinal below 10 collect (test-visibility ordinal #(1 3 5 7) 4))
321
 
322
 (cffi:defcallback %compare-keys :int ((lhs :pointer) (rhs :pointer))
323
   (%compare-lmdb-keys lhs rhs))
324
 
325
 (defun %compare-lmdb-keys (lhs rhs)
326
   (declare (type SB-SYS:SYSTEM-AREA-POINTER lhs rhs)
327
            (optimize (speed 3) (safety 0) (space 3)))
328
   #|
329
   (assert (= 16 (cffi:pointer-address (cffi:foreign-slot-value lhs '(:struct liblmdb:val) 'liblmdb:mv-size)))
330
           ()
331
           "key size is invalid: ~s" (cffi:pointer-address (cffi:foreign-slot-value lhs '(:struct liblmdb:val) 'liblmdb:mv-size)))
332
   (assert (= 16 (cffi:pointer-address (cffi:foreign-slot-value rhs '(:struct liblmdb:val) 'liblmdb:mv-size)))
333
           ()
334
           "key size is invalid: ~s" (cffi:pointer-address (cffi:foreign-slot-value rhs '(:struct liblmdb:val) 'liblmdb:mv-size)))
335
   |#
336
   (let ((lhs-quad (cffi:foreign-slot-value lhs '(:struct liblmdb:val) 'liblmdb:mv-data))
337
         (rhs-quad (cffi:foreign-slot-value rhs '(:struct liblmdb:val) 'liblmdb:mv-data)))
338
     (declare (dynamic-extent lhs-quad rhs-quad))
339
     (%compare-quad lhs-quad rhs-quad))
340
   )
341
 
342
 
343
 (declaim (type (function (SB-SYS:SYSTEM-AREA-POINTER SB-SYS:SYSTEM-AREA-POINTER) fixnum) %compare-quad))
344
 
345
 (defun %compare-quad (lhs rhs)
346
   (declare (dynamic-extent lhs rhs)
347
            (optimize (speed 3) (safety 0)))
348
   #+(or)
349
   (progn
350
     (print :%compare-quad *trace-output*)
351
     (%print-quad lhs *trace-output*)
352
     (%print-quad rhs *trace-output*))
353
   (if (eql lhs rhs)
354
       0
355
       (loop for i below 4
356
         for lhs_i = (cffi:mem-aref lhs 'term-id i) 
357
         for rhs_i = (cffi:mem-aref rhs 'term-id i) 
358
         if (< lhs_i rhs_i)
359
         return -1
360
         if (> lhs_i rhs_i)
361
         return 1
362
         finally (return 0))))
363
 
364
 (defun %quad-less-p (lhs rhs)
365
   (eql (%compare-quad lhs rhs) -1))
366
 
367
 (defun compare-quad (lhs rhs)
368
   (if (eql lhs rhs)
369
       0
370
       (flet ((cmp-term (lhst rhst)
371
                (let ((sign (signum (- lhst rhst))))
372
                  (unless (zerop sign)
373
                    (return-from compare-quad sign)))))
374
         (map nil #'cmp-term lhs rhs)
375
         0)))
376
 ;;; (compare-quad #(0 0 0 0) #(0 0 0 0))
377
 
378
 
379
 ;;; temporal keys
380
 
381
 (macrolet ((def-compare-tquad (name order)
382
              (let* ((name (cons-symbol *package* 'compare-tquad- name))
383
                     (%name (cons-symbol *package* '% name))
384
                     (fields #(context subject predicate time))
385
                     (clauses (loop for i below 4
386
                                for accessor = (cons-symbol *package* '%tquad- (aref fields i))
387
                                collect `(let ((sign (signum (- (,accessor lhs) (,accessor rhs)))))
388
                                           (unless (zerop sign)
389
                                             (return-from ,name sign))))))
390
                `(progn (defun ,name (lhs rhs)
391
                          ,@(loop for ref across order
392
                              collect (nth ref clauses))
393
                          0)
394
                   (cffi:defcallback ,%name :int ((lhs :pointer) (rhs :pointer))
395
                     (,name lhs rhs))))))
396
   (def-compare-tquad gspt #(0 1 2 3))
397
   (def-compare-tquad gpts #(0 2 3 1)) 
398
   (def-compare-tquad gtsp #(0 3 1 2))
399
   (def-compare-tquad sptg #(1 2 3 0))
400
   (def-compare-tquad ptsg #(2 3 1 0))
401
   (def-compare-tquad tspg #(3 1 2 0)))
402