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

KindCoveredAll%
expression0895 0.0
branch086 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.rlmdb.implementation; -*-
2
 
3
 (in-package :rlmdb.i)
4
 
5
 (:documentation "time-series databases"
6
                 "Implement operations specific to time-series databases.
7
  These add to (g x s x p) indices a term for to designate revisions as a
8
  proxy for application domain events.
9
  They permit to retrieve triples in either a temporally dominant order or
10
  one in which application domain entities dominate, but the event time
11
  remains available as a secondary order.
12
  The index can record one of
13
  - revision ordinal
14
  - revision uuid
15
  - revision timestamp
16
  for each index entry, the data can be one of
17
  - null : retains the lastest state only
18
  - ordinal-vector : interpreted as an insertion/deletion linear index
19
  - uuid-vector : interpreted as a replication record
20
  Mapping over index entries treats the key values uniformly independent of sort order.
21
 
22
  * classes
23
  - rlmdb:revision-ordinal-database : the designator is the revision ordinal.
24
  - rlmdb:revision-timestamp-database : the designator is the revision begin timestamp.
25
  - rlmdb:revision-identifier-database : the designator is the revision uuid.
26
 
27
 the map-collated-index-statements operator delegates to the simple
28
 map-index-statements operator for the given index database and collates
29
 per-predicate solutions for constant event/graph/subject
30
 ")
31
 
32
 
33
 (defmethod repository-time-series-predicate-ids ((index-database rlmdb::time-series-database))
34
   (repository-time-series-predicate-ids (database-repository index-database)))
35
 
36
 (defmethod rlmdb::map-collated-index-statements (continuation (index-database rlmdb::time-series-database) patterns &rest args)
37
   "For cases where the non-event terms are wild, map and correlate with event identifer as
38
   the dominant order."
39
     (let* ((subject 0)
40
            (context 0)
41
            (event 0)
42
            (predicates (repository-time-series-predicate-ids index-database))
43
            (solution-vector (make-array (+ 3 (length predicates)) :initial-element 0))
44
            (quad-pattern (copy-seq (first patterns)))
45
            (event-map (make-hash-table :test #'equal)) ;; weak-keyed for large result sets?
46
            )
47
       (setf (aref quad-pattern 2) 0)
48
       ;;(print (list :predicates predicates))
49
       (labels ((construct-solution (%tsiquad)
50
                ;;(%print-quad %tsiquad *trace-output*)
51
                ;; accept each matched quad, collate by
52
                (let ((next-event (database-quad-event-key index-database %tsiquad))
53
                      (next-context (spocq.i::%tsiquad-context %tsiquad))
54
                      (next-subject (spocq.i::%tsiquad-subject %tsiquad))
55
                      (predicate-index (position (spocq.i::%tsiquad-predicate %tsiquad) predicates))
56
                      (next-object (spocq.i::%tsiquad-object %tsiquad)))
57
                  ;;(print (list next-event next-context next-subject predicate-index next-object))
58
                  (cond (predicate-index
59
                         (when (/= subject 0)
60
                           (unless (and (= subject next-subject)
61
                                        (= context next-context)
62
                                        (equalp event next-event))
63
                             ;;(print (list :continued solution-vector))
64
                             (funcall continuation solution-vector)
65
                             (fill solution-vector 0 :start 3)))
66
                         (setf subject next-subject
67
                               context next-context
68
                               event next-event)
69
                         (setf (aref solution-vector 0) (event-term-number next-event)
70
                               (aref solution-vector 1) context
71
                               (aref solution-vector 2) subject)
72
                         (setf (aref solution-vector (+ 3 predicate-index)) next-object))
73
                        (t ;; skip
74
                         ))))
75
                (event-term-number (event-designator)
76
                  (cond ((gethash event-designator event-map))
77
                        (t
78
                         (setf (gethash event-designator event-map)
79
                               (spocq.i::rdfcache-object-term-number nil event-designator))))))
80
         (declare (dynamic-extent #'construct-solution))
81
         (multiple-value-prog1 (apply #'rlmdb::map-index-statements #'construct-solution index-database quad-pattern args)
82
           (unless (= subject 0)
83
             (funcall continuation solution-vector))))))
84
 
85
 
86
 ;;; as a first pass, just the ordinal database is used.
87
 ;;; once it isvalidated, these could be unified by abstracting the record sizes and element access.
88
 ;;; they differ just in the revision designator which is appended to the quad terms as the key
89
 ;;; - tsiquad : g-s-p-o + revision ordinal (4 bytes)
90
 ;;; - tstquad : g-s-p-o + unix timestamp (8 bytes)
91
 ;;; - tsiquad : g-s-p-o + revision uuid (16 bytes)
92
 
93
 (defmethod rlmdb::map-index-statements (operator (database rlmdb::ordinal-time-series-database) (quad-pattern t) 
94
                                                      &key predicates
95
                                                      (domain-predicate nil)
96
                                                      (revision-predicate nil))
97
   "Iterate over graph content in a revision ordinal database.
98
   - extract the filter's initial identifier:
99
   - locate the first entry according to the initial identifier
100
   - iterate as long as the optional time-series predicate is satisfied
101
   - optionally filter for revision visibility
102
   - collate quads with given time-series identifers into respective solutions
103
   - yield each solution together with the respective time series identifier, context and subject
104
   "
105
 
106
   (declare (ignore predicates))
107
   (assert (or (null domain-predicate) (spocq.i::domain-predicate-p domain-predicate)) ()
108
           "rlmdb::map-index-statements: Invalid time-series filter: ~s ~s" database domain-predicate)
109
   (assert (or (null revision-predicate) (spocq.i::revision-predicate-p revision-predicate)) ()
110
           "rlmdb::map-index-statements: Invalid revision filter: ~s ~s" database revision-predicate)
111
   (lmdb:with-database (database)
112
     (let* ((cur (lmdb:make-cursor database :transaction lmdb:*transaction*))
113
            (named-only (case (graph quad-pattern)
114
                          ((-2 |urn:dydra|:|named|) t)
115
                          (t nil)))
116
            (graph-none (case (graph quad-pattern)
117
                          ((-4 |urn:dydra|:|none|) t)
118
                          (t nil)))
119
            (wild-pattern-p (wild-quad-pattern-p quad-pattern))
120
            (domain-min (if domain-predicate (spocq.i::domain-predicate-min domain-predicate)))
121
            (match-count 0)
122
            (scan-count 0)
123
            (key-size (cffi:foreign-type-size '(:struct spocq.i::tsoquad)))
124
            (default-graph-term-id (rlmdb:transaction-default-context-term-id lmdb:*transaction*)))
125
       (cffi:with-foreign-objects ((%tsoquad-pattern '(:struct spocq.i::tsoquad))
126
                                   (%key-tsoquad '(:struct spocq.i::tsoquad)))
127
         (lmdb::with-empty-value (raw-key)
128
           (lmdb::with-empty-value (raw-value)
129
             (flet ((map-for-graph (quad-pattern)
130
                      ;; if a term object quad is given a nil result indicates
131
                      ;; that some term is not in the store, which means there
132
                      ;; can be no match.
133
                      (unless (quad-to-tsoquad-record quad-pattern %tsoquad-pattern)
134
                        (return-from map-for-graph nil))
135
                      (setf (%tsoquad-ordinal %tsoquad-pattern)
136
                            (if domain-min
137
                                (case (when domain-predicate (spocq.i::domain-predicate-min-op domain-predicate))
138
                                  (spocq.a:> (1+ domain-min))
139
                                  (t domain-min))
140
                                0))
141
                      ;;(print (list :domain-min domain-min :domain-predicate domain-predicate))
142
                      (%copy-tsoquad %tsoquad-pattern %key-tsoquad)
143
                      (lmdb:with-cursor (cur)
144
                        (let ((%cursor (lmdb::handle cur)))
145
                          (labels ((next-entry (get-op)
146
                                     (ecase get-op
147
                                       (:+set-range+
148
                                        (setf (%mdb-val-size raw-key) key-size
149
                                              (%mdb-val-data raw-key) %key-tsoquad))
150
                                       (:+next+ ))
151
                                     ;;(%print-tsoquad %key-tsoquad *trace-output*)
152
                                     (let ((return-code (liblmdb:cursor-get %cursor raw-key raw-value get-op)))
153
                                       ;;(print (list :return-code return-code))
154
                                       (alexandria:switch (return-code)
155
                                                          (0
156
                                                           (call-with-entry raw-key raw-value))
157
                                                          (liblmdb:+notfound+
158
                                                           nil)
159
                                                          (t
160
                                                           (lmdb::unknown-error return-code)))))
161
                                   (call-with-entry (k v)
162
                                     (assert (= key-size (%mdb-val-size k))
163
                                             ()
164
                                             "rlmdb::map-index-statements: Invalid key size: ~s ~s" database (%mdb-val-size k))
165
                                     (let* ((%index-tsoquad (%mdb-val-data k))
166
                                            (visibility-bytes (%mdb-val-size v)))
167
                                       ;; continue until either no longer matched
168
                                       (cond ((and named-only (=  (spocq.i::%tsoquad-context %index-tsoquad) default-graph-term-id))
169
                                              ;; skip
170
                                              t)
171
                                             ((and (or wild-pattern-p (%quad-match-p %tsoquad-pattern %index-tsoquad))
172
                                                   (or (null domain-predicate)
173
                                                       (funcall domain-predicate (spocq.i::%tsoquad-ordinal %index-tsoquad))))
174
                                              (when (or (zerop visibility-bytes)
175
                                                        (null revision-predicate)
176
                                                        ;; for bi-temporal cases
177
                                                        (funcall revision-predicate (%mdb-val-data v) visibility-bytes))
178
                                                ;; iff still in range, satisfying predicate and visible, then match
179
                                                (map-revision-ordinal-database-callback operator %index-tsoquad)
180
                                                (incf match-count))
181
                                              (incf scan-count))
182
                                             (t
183
                                              ;; otherwise end
184
                                              nil)))))
185
                            (loop for op = :+set-range+ then :+next+
186
                              while (next-entry op)))))))
187
               (typecase (graph quad-pattern) ;; if a set enumerate, other wise scan the single graph
188
                 (cons (loop with single-graph-quad-pattern = (copy-quad-pattern quad-pattern)
189
                         for graph in (graph quad-pattern)
190
                         do (progn (setf (graph single-graph-quad-pattern) graph)
191
                              (map-for-graph single-graph-quad-pattern))))
192
                 (t (unless graph-none
193
                      (when named-only ;; with special handling for named graphs
194
                        (setf (graph quad-pattern) 0))
195
                      (map-for-graph quad-pattern))))))))
196
       (values scan-count match-count))))
197
 
198
 
199
 (defun map-revision-ordinal-database-callback (operator xquad)
200
   #+(or)
201
   (when cl-user::*map-index-statements-callback.verbose*
202
     (let ((quad-string (with-output-to-string (stream) (spocq.i::%print-tsoquad xquad stream))))
203
       (format *trace-output* "mrs: ~a" quad-string)))
204
   (funcall operator xquad))
205
 
206
 
207
 (defmethod rlmdb::map-index-statements (operator (database rlmdb::timestamp-time-series-database) (quad-pattern t) 
208
                                                      &key predicates
209
                                                      (domain-predicate nil)
210
                                                      (revision-predicate nil))
211
   "Iterate over graph content in a revision timestamp database.
212
   - extract the filter's initial identifier:
213
   - locate the first entry according to the initial identifier
214
   - iterate as long as the optional time-series predicate is satisfied
215
   - optionally filter for revision visibility
216
   - collate quads with given time-stamps into respective solutions
217
   - yield each solution together with the respective time series identifier, context and subject
218
   "
219
 
220
   (declare (ignore predicates))
221
   (assert (or (null domain-predicate) (spocq.i::domain-predicate-p domain-predicate)) ()
222
           "rlmdb::map-index-statements: Invalid time-series filter: ~s ~s" database domain-predicate)
223
   (assert (or (null revision-predicate) (spocq.i::revision-predicate-p revision-predicate)) ()
224
           "rlmdb::map-index-statements: Invalid revision filter: ~s ~s" database revision-predicate)
225
   (lmdb:with-database (database)
226
     (let* ((cur (lmdb:make-cursor database :transaction lmdb:*transaction*))
227
            (named-only (case (graph quad-pattern)
228
                          ((-2 |urn:dydra|:|named|) t)
229
                          (t nil)))
230
            (graph-none (case (graph quad-pattern)
231
                          ((-4 |urn:dydra|:|none|) t)
232
                          (t nil)))
233
            (wild-pattern-p (wild-quad-pattern-p quad-pattern))
234
            (domain-min (if domain-predicate (spocq.i::domain-predicate-min domain-predicate)))
235
            (match-count 0)
236
            (scan-count 0)
237
            (key-size (cffi:foreign-type-size '(:struct tstquad)))
238
            (default-graph-term-id #xffffffff))
239
       (cffi:with-foreign-objects ((%tstquad-pattern '(:struct tstquad))
240
                                   (%key-tstquad '(:struct tstquad)))
241
         (lmdb::with-empty-value (raw-key)
242
           (lmdb::with-empty-value (raw-value)
243
             (flet ((map-for-graph (quad-pattern)
244
                      (incf match-count)
245
                      ;; if a term object quad is given a nil result indicates
246
                      ;; that some term is not in the store, which means there
247
                      ;; can be no match.
248
                      (unless (quad-to-tstquad-record quad-pattern %tstquad-pattern)
249
                        (return-from map-for-graph nil))
250
                      (when domain-min
251
                        (setf (%tstquad-time %tstquad-pattern)
252
                              (case (when domain-predicate (spocq.i::domain-predicate-min-op domain-predicate))
253
                                (spocq.a:> (1+ domain-min))
254
                                (t domain-min))))
255
                      (%copy-tstquad %tstquad-pattern %key-tstquad)
256
                      (lmdb:with-cursor (cur)
257
                        (let ((%cursor (lmdb::handle cur)))
258
                          (labels ((next-entry (get-op)
259
                                   (ecase get-op
260
                                     (:+set-range+
261
                                      (setf (%mdb-val-size raw-key) key-size
262
                                            (%mdb-val-data raw-key) %key-tstquad)
263
                                      )
264
                                     (:+next+ ))
265
                                   (let ((return-code (liblmdb:cursor-get %cursor raw-key raw-value get-op)))
266
                                     (alexandria:switch (return-code)
267
                                                        (0
268
                                                         (call-with-entry raw-key raw-value))
269
                                                        (liblmdb:+notfound+
270
                                                         nil)
271
                                                        (t
272
                                                         (lmdb::unknown-error return-code)))))
273
                                 (call-with-entry (k v)
274
                                   (assert (= key-size (%mdb-val-size k))
275
                                           ()
276
                                           "rlmdb::map-index-statements: Invalid key size: ~s ~s" database (%mdb-val-size k))
277
                                   (let* ((%index-tstquad (%mdb-val-data k))
278
                                          (visibility-bytes (%mdb-val-size v)))
279
                                     ;; continue until either no longer matched
280
                                     (cond ((and named-only (=  (%tstquad-context %index-tstquad) default-graph-term-id))
281
                                            ;; skip
282
                                            t)
283
                                           ((and (or wild-pattern-p (%quad-match-p %tstquad-pattern %index-tstquad))
284
                                                 (or (null domain-predicate)
285
                                                     (funcall domain-predicate (%tstquad-time %index-tstquad))))
286
                                            ;; the test constrains just c.s.p.o. timestamp is handled by the predicate
287
                                            (incf scan-count)
288
                                            (when (or (zerop visibility-bytes)
289
                                                      (null revision-predicate)
290
                                                      (funcall revision-predicate (%mdb-val-data v) visibility-bytes))
291
                                              ;; iff still in range, satisfying predicate and visible, then match
292
                                              (map-revision-timestamp-database-callback operator %index-tstquad)
293
                                              (incf match-count)))
294
                                           (t
295
                                            ;; otherwise end
296
                                            nil)))))
297
                      (loop for op = :+set-range+ then :+next+
298
                        while (next-entry op)))))))
299
           (typecase (graph quad-pattern) ;; if a set enumerate, other wise scan the single graph
300
             (cons (loop with single-graph-quad-pattern = (copy-quad-pattern quad-pattern)
301
                     for graph in (graph quad-pattern)
302
                     do (progn (setf (graph single-graph-quad-pattern) graph)
303
                          (map-for-graph single-graph-quad-pattern))))
304
             (t (unless graph-none
305
                  (when named-only ;; with special handling for named graphs
306
                    (setf (graph quad-pattern) 0))
307
                  (map-for-graph quad-pattern))))))))
308
       (values scan-count match-count))))
309
 
310
 (defun map-revision-timestamp-database-callback (operator xquad)
311
   #+(or)
312
   (when cl-user::*map-index-statements-callback.verbose*
313
     (let ((quad-string (with-output-to-string (stream) (spocq.i::%print-tstquad xquad stream))))
314
       (format *trace-output* "mrs: ~a" quad-string)))
315
   (funcall operator xquad))
316
 
317
 
318
 (defmethod rlmdb::map-index-statements (operator (database rlmdb::identifier-time-series-database) (quad-pattern t) 
319
                                                      &key predicates
320
                                                      (domain-predicate nil)
321
                                                      (revision-predicate nil))
322
   "Iterate over graph content in a revision identifier database.
323
   - extract the filter's initial identifier:
324
   - locate the first entry according to the initial identifier
325
   - iterate as long as the optional time-series predicate is satisfied
326
   - optionally filter for revision visibility
327
   - collate quads with given time-series identifers in to respective solutions
328
   - yield each solution together with the respective time series identifier, context and subject
329
   "
330
 
331
   (declare (ignore predicates))
332
   (assert (or (null domain-predicate) (spocq.i::domain-predicate-p domain-predicate)) ()
333
           "rlmdb::map-index-statements: Invalid time-series filter: ~s ~s" database domain-predicate)
334
   (assert (or (null revision-predicate) (spocq.i::revision-predicate-p revision-predicate)) ()
335
           "rlmdb::map-index-statements: Invalid revision filter: ~s ~s" database revision-predicate)
336
   (lmdb:with-database (database)
337
     (let* ((cur (lmdb:make-cursor database :transaction lmdb:*transaction*))
338
            (named-only (case (graph quad-pattern)
339
                          ((-2 |urn:dydra|:|named|) t)
340
                          (t nil)))
341
            (graph-none (case (graph quad-pattern)
342
                          ((-4 |urn:dydra|:|none|) t)
343
                          (t nil)))
344
            (wild-pattern-p (wild-quad-pattern-p quad-pattern))
345
            (first-ts-identifier  (if domain-predicate (spocq.i::domain-predicate-min domain-predicate) 0))
346
            (match-count 0)
347
            (scan-count 0)
348
            (key-size (cffi:foreign-type-size '(:struct tsiquad)))
349
            (default-graph-term-id #xffffffff))
350
       (cffi:with-foreign-objects ((%tsiquad-pattern '(:struct tsiquad))
351
                                   (%key-tsiquad '(:struct tsiquad)))
352
         (lmdb::with-empty-value (raw-key)
353
           (lmdb::with-empty-value (raw-value)
354
             (flet ((map-for-graph (quad-pattern)
355
                      (incf match-count)
356
                      ;; if a term object quad is given a nil result indicates
357
                      ;; that some term is not in the store, which means there
358
                      ;; can be no match.
359
                      (unless (quad-to-tsiquad-record quad-pattern %tsiquad-pattern)
360
                        (return-from map-for-graph nil))
361
                      (%copy-tsiquad %tsiquad-pattern %key-tsiquad)
362
                      (lmdb:with-cursor (cur)
363
                        (let ((%cursor (lmdb::handle cur)))
364
                          (labels ((next-entry (get-op)
365
                                   (ecase get-op
366
                                     (:+set-range+
367
                                      (setf (%mdb-val-size raw-key) key-size
368
                                            (%mdb-val-data raw-key) %key-tsiquad)
369
                                      )
370
                                     (:+next+ ))
371
                                   (let ((return-code (liblmdb:cursor-get %cursor raw-key raw-value get-op)))
372
                                     (alexandria:switch (return-code)
373
                                                        (0
374
                                                         (call-with-entry raw-key raw-value))
375
                                                        (liblmdb:+notfound+
376
                                                         nil)
377
                                                        (t
378
                                                         (lmdb::unknown-error return-code)))))
379
                                 (call-with-entry (k v)
380
                                   (assert (= key-size (%mdb-val-size k))
381
                                           ()
382
                                           "rlmdb::map-index-statements: Invalid key size: ~s ~s" database (%mdb-val-size k))
383
                                   (let* ((%index-tsiquad (%mdb-val-data k))
384
                                          (visibility-bytes (%mdb-val-size v)))
385
                                     ;; continue until either no longer matched
386
                                     (cond ((and named-only (=  (%tsiquad-context %index-tsiquad) default-graph-term-id))
387
                                            ;; skip
388
                                            t)
389
                                           ((and (or wild-pattern-p (%quad-match-p %tsiquad-pattern %index-tsiquad))
390
                                                 (or (null domain-predicate)
391
                                                     (funcall domain-predicate (%tsiquad-uuid %index-tsiquad))))
392
                                            ;; the test constrains just c.s.p.o. tsid is handled by the predicate
393
                                            (incf scan-count)
394
                                            (when (or (zerop visibility-bytes)
395
                                                      (null revision-predicate)
396
                                                      (funcall revision-predicate (%mdb-val-data v) visibility-bytes))
397
                                              ;; iff still in range, satisfying predicate and visible, then match
398
                                              (map-revision-identifier-database-callback operator %index-tsiquad)
399
                                              (incf match-count)))
400
                                           (t
401
                                            ;; otherwise end
402
                                            nil)))))
403
                      (loop for op = :+set-range+ then :+next+
404
                        while (next-entry op)))))))
405
           (typecase (graph quad-pattern) ;; if a set enumerate, other wise scan the single graph
406
             (cons (loop with single-graph-quad-pattern = (copy-quad-pattern quad-pattern)
407
                     for graph in (graph quad-pattern)
408
                     do (progn (setf (graph single-graph-quad-pattern) graph)
409
                          (map-for-graph single-graph-quad-pattern))))
410
             (t (unless graph-none
411
                  (when named-only ;; with special handling for named graphs
412
                    (setf (graph quad-pattern) 0))
413
                  (map-for-graph quad-pattern))))))))
414
       (values scan-count match-count))))
415
 
416
 (defun map-revision-identifier-database-callback (operator xquad)
417
   #+(or)
418
   (when cl-user::*map-index-statements-callback.verbose*
419
     (let ((quad-string (with-output-to-string (stream) (spocq.i::%print-tsiquad xquad stream))))
420
       (format *trace-output* "mrs: ~a" quad-string)))
421
   (funcall operator xquad))
422
 
423
 
424
 
425
 (defmethod rlmdb::repository-insert-statement
426
   ((repository rlmdb::ordinal-time-series-index-repository) (transaction rlmdb:transaction) graph subject predicate object)
427
 
428
   (if (or (null (repository-time-series-predicates repository))
429
           (rlmdb:repository-time-series-predicate-p repository predicate))
430
       (cffi:with-foreign-objects ((%key-quad '(:struct tsiquad)))
431
         (rlmdb.i::with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tsoquad))) %key-quad))
432
           (let* ((db (aref (repository-time-series-databases repository) 0))
433
                  (ordinal (lmdb:transaction-id transaction)))
434
             (setf (%tsoquad-context %KEY-quad) graph
435
                   (%tsoquad-subject %KEY-quad) subject
436
                   (%tsoquad-predicate %KEY-quad) predicate
437
                   (%tsoquad-object %KEY-quad) object
438
                   (%tsoquad-ordinal %KEY-quad) ordinal)
439
             (multiple-value-bind (index-data operation)
440
                                  (rlmdb::compute-index-insertion-data db transaction %key)
441
               #+(or)
442
               (print (list operation index-data
443
                            (list (%tsoquad-context %KEY-quad) (%tsoquad-subject %KEY-quad) 
444
                                  (%tsoquad-predicate %KEY-quad) (%tsoquad-object %KEY-quad)
445
                                  (%tsoquad-ordinal %KEY-quad))
446
                            (with-output-to-string (stream)
447
                              (loop for i below (cffi:foreign-type-size '(:struct tsoquad))
448
                                do (format stream "~2,'0x" (cffi:mem-aref %KEY-quad :uint8 i))))))
449
               (case operation
450
                 ((nil) ;; nothing to change
451
                  nil)
452
                 (:put ;; if the statement is already present, there is nothing to do
453
                  (let* ((ordinal-size (repository-ordinal-size repository))
454
                         (record-length (* (length index-data) ordinal-size)))
455
                    (cffi:with-foreign-pointer (%index-record record-length)
456
                      (with-lmdb-values ((%value record-length %index-record))
457
                        (loop for i below (length index-data)
458
                          do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
459
                        (loop with index-databases = (repository-time-series-databases repository)
460
                          for db across index-databases 
461
                          do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
462
                               (unless (zerop return-code)
463
                                 (lmdb::unknown-error return-code)))))))
464
                  t))))))
465
       (call-next-method)))
466
 
467
 
468
 (defmethod rlmdb::repository-insert-statement
469
   ((repository rlmdb::timestamp-time-series-index-repository) (transaction rlmdb:transaction) graph subject predicate object)
470
   (if (or (null (repository-time-series-predicates repository))
471
           (rlmdb:repository-time-series-predicate-p repository predicate))
472
       (cffi:with-foreign-objects ((%key-quad '(:struct tstquad)))
473
         (rlmdb.i::with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tstquad))) %key-quad))
474
           (setf (%tstquad-context %KEY-quad) graph
475
                 (%tstquad-subject %KEY-quad) subject
476
                 (%tstquad-predicate %KEY-quad) predicate
477
                 (%tstquad-object %KEY-quad) object
478
                 (%tstquad-time %KEY-quad) (transaction-timestamp spocq.i:*transaction*))
479
           (let* ((db (aref (repository-time-series-databases repository) 0)))
480
             (multiple-value-bind (index-data operation)
481
                                  (rlmdb::compute-index-insertion-data db transaction %key)
482
               (case operation
483
                 ((nil) ;; nothing to change
484
                  nil)
485
                 (:put ;; if the statement is already present, there is nothing to do
486
                  (let* ((ordinal-size (repository-ordinal-size repository))
487
                         (record-length (* (length index-data) ordinal-size)))
488
                    (cffi:with-foreign-pointer (%index-record record-length)
489
                      (with-lmdb-values ((%value record-length %index-record))
490
                        (loop for i below (length index-data)
491
                          do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
492
                        (loop with index-databases = (repository-time-series-databases repository)
493
                          for db across index-databases 
494
                          do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
495
                               (unless (zerop return-code)
496
                                 (lmdb::unknown-error return-code)))))))
497
                  t))))))
498
       (call-next-method)))
499
 
500
 (defmethod rlmdb::repository-insert-statement
501
   ((repository rlmdb::identifier-time-series-index-repository) (transaction lmdb:transaction) graph subject predicate object)
502
   (if (or (null (repository-time-series-predicates repository))
503
           (rlmdb:repository-time-series-predicate-p repository predicate))
504
       (cffi:with-foreign-objects ((%key-quad '(:struct tsiquad)))
505
         (rlmdb.i::with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tsiquad))) %key-quad))
506
           (setf (%tsiquad-context %KEY-quad) graph
507
                 (%tsiquad-subject %KEY-quad) subject
508
                 (%tsiquad-predicate %KEY-quad) predicate
509
                 (%tsiquad-object %KEY-quad) object)
510
           (spocq.i::%encode-uuid (spocq.i::transaction-id spocq.i:*transaction*)
511
                                  (cffi:foreign-slot-pointer %KEY-quad '(:struct tsiquad) 'spocq.i::uuid))
512
           (let* ((db (aref (repository-time-series-databases repository) 0)))
513
             (multiple-value-bind (index-data operation)
514
                                  (rlmdb::compute-index-insertion-data db transaction %key)
515
               (case operation
516
                 ((nil) ;; nothing to change
517
                  nil)
518
                 (:put ;; if the statement is already present, there is nothing to do
519
                  (let* ((ordinal-size (repository-ordinal-size repository))
520
                         (record-length (* (length index-data) ordinal-size)))
521
                    (cffi:with-foreign-pointer (%index-record record-length)
522
                      (with-lmdb-values ((%value record-length %index-record))
523
                        (loop for i below (length index-data)
524
                          do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
525
                        (loop with index-databases = (repository-time-series-databases repository)
526
                          for db across index-databases 
527
                          do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
528
                               (unless (zerop return-code)
529
                                 (lmdb::unknown-error return-code))))))
530
                    t)))))))
531
       (call-next-method)))
532
 
533
 
534
 
535
 (defmethod rlmdb::repository-delete-statement any
536
   ((repository rlmdb::ordinal-time-series-index-repository) (transaction rlmdb:transaction) graph subject predicate object)
537
   (cffi:with-foreign-objects ((%key-quad '(:struct tsiquad)))
538
     (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tsiquad))) %key-quad))
539
       (setf (%tsoquad-context %KEY-quad) graph
540
             (%tsoquad-subject %KEY-quad) subject
541
             (%tsoquad-predicate %KEY-quad) predicate
542
             (%tsoquad-object %KEY-quad) object
543
             (%tsoquad-ordinal %KEY-quad) (lmdb:transaction-id transaction))
544
         (let* ((db (aref (repository-time-series-databases repository) 0)))
545
           (multiple-value-bind (index-data operation)
546
                                (rlmdb::compute-index-deletion-data db transaction %key)
547
             (case operation
548
               ((nil) ;; nothing to change
549
                nil)
550
               (:put
551
                ;; if the statement is already presentand the data is to be modified
552
                (let* ((ordinal-size (repository-ordinal-size repository))
553
                       (record-length (* (length index-data) ordinal-size)))
554
                  (cffi:with-foreign-pointer (%index-record record-length)
555
                    (with-lmdb-values ((%value record-length %index-record))
556
                      (loop for i below (length index-data)
557
                        do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
558
                      (loop with index-databases = (repository-time-series-databases repository)
559
                        for db across index-databases 
560
                        do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
561
                             (unless (zerop return-code)
562
                               (lmdb::unknown-error return-code)))))))
563
                t)
564
               (:del
565
                (loop with index-databases = (repository-time-series-databases repository)
566
                  for db across index-databases
567
                  do (let ((return-code (liblmdb:del (lmdb::handle transaction) (lmdb::handle db) %key (cffi:null-pointer))))
568
                       (unless (zerop return-code)
569
                         (lmdb::unknown-error return-code))))
570
                t)))))))
571
 
572
 (defmethod rlmdb::repository-delete-statement any
573
   ((repository rlmdb::timestamp-time-series-index-repository) (transaction rlmdb:transaction) graph subject predicate object)
574
     (cffi:with-foreign-objects ((%key-quad '(:struct tstquad)))
575
       (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tstquad))) %key-quad))
576
         (setf (%tstquad-context %KEY-quad) graph
577
               (%tstquad-subject %KEY-quad) subject
578
               (%tstquad-predicate %KEY-quad) predicate
579
               (%tstquad-object %KEY-quad) object
580
               (%tstquad-time %KEY-quad) (transaction-timestamp spocq.i:*transaction*))
581
         (let* ((db (aref (repository-time-series-databases repository) 0)))
582
           (multiple-value-bind (index-data operation)
583
                                (rlmdb::compute-index-deletion-data db transaction %key)
584
             (case operation
585
               ((nil) ;; nothing to change
586
                nil)
587
               (:put
588
                ;; if the statement is already presentand the data is to be modified
589
                (let* ((ordinal-size (repository-ordinal-size repository))
590
                       (record-length (* (length index-data) ordinal-size)))
591
                  (cffi:with-foreign-pointer (%index-record record-length)
592
                    (with-lmdb-values ((%value record-length %index-record))
593
                      (loop for i below (length index-data)
594
                        do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
595
                      (loop with index-databases = (repository-time-series-databases repository)
596
                        for db across index-databases 
597
                        do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
598
                             (unless (zerop return-code)
599
                               (lmdb::unknown-error return-code)))))))
600
                t)
601
               (:del
602
                (loop with index-databases = (repository-time-series-databases repository)
603
                  for db across index-databases
604
                  do (let ((return-code (liblmdb:del (lmdb::handle transaction) (lmdb::handle db) %key (cffi:null-pointer))))
605
                       (unless (zerop return-code)
606
                         (lmdb::unknown-error return-code))))
607
                t)))))))
608
 
609
 (defmethod rlmdb::repository-delete-statement any
610
   ((repository rlmdb::identifier-time-series-index-repository) (transaction lmdb:transaction) graph subject predicate object)
611
   (cffi:with-foreign-objects ((%key-quad '(:struct tsiquad)))
612
     (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tsiquad))) %key-quad))
613
         (setf (%tsiquad-context %KEY-quad) graph
614
               (%tsiquad-subject %KEY-quad) subject
615
               (%tsiquad-predicate %KEY-quad) predicate
616
               (%tsiquad-object %KEY-quad) object)
617
         (spocq.i::%encode-uuid (spocq.i::transaction-id spocq.i:*transaction*)
618
                                (cffi:foreign-slot-pointer %KEY-quad '(:struct tsiquad) 'spocq.i::uuid))
619
         (let* ((db (aref (repository-time-series-databases repository) 0)))
620
           (multiple-value-bind (index-data operation)
621
                                (rlmdb::compute-index-deletion-data db transaction %key)
622
             (case operation
623
               ((nil) ;; nothing to change
624
                nil)
625
               (:put
626
                ;; if the statement is already presentand the data is to be modified
627
                (let* ((ordinal-size (repository-ordinal-size repository))
628
                       (record-length (* (length index-data) ordinal-size)))
629
                  (cffi:with-foreign-pointer (%index-record record-length)
630
                    (with-lmdb-values ((%value record-length %index-record))
631
                      (loop for i below (length index-data)
632
                        do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
633
                      (loop with index-databases = (repository-time-series-databases repository)
634
                        for db across index-databases 
635
                        do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
636
                             (unless (zerop return-code)
637
                               (lmdb::unknown-error return-code)))))))
638
                t)
639
               (:del
640
                (loop with index-databases = (repository-time-series-databases repository)
641
                  for db across index-databases
642
                  do (let ((return-code (liblmdb:del (lmdb::handle transaction) (lmdb::handle db) %key (cffi:null-pointer))))
643
                       (unless (zerop return-code)
644
                         (lmdb::unknown-error return-code))))
645
                t)))))))
646
 
647
 #|
648
 #+(or) ;; superseded by rlmdb::map-collated-index-statements
649
 (defmethod rlmdb::map-index-statements :around
650
   (continuation (database rlmdb::time-series-database) quad-patterns &rest args
651
                 &key
652
                 domain-predicate
653
                 event-predicate
654
                 revision-predicate)
655
   "If a predicate set is supplied, compute an operator to wrap the index
656
   method with a continuation which constructs the nodes as term sequences.
657
   Accept
658
   - a continuation
659
   - the database, 
660
   - a quad pattern
661
   - key arguments : predicates (others are ignored)
662
   The wrapper invokes the concrete method and consumes the matched quads to
663
   collate by temporal identifer and (context x subject) those solutions which
664
   present one of the given predicates.
665
   For each solution, invoke the continuation for vector of the solution terms,
666
   ordered as per the given predicate list.
667
   If no predicate constraint is supplied, treat it as an unmodified scan."
668
 
669
   (declare (dynamic-extent args)
670
            (dynamic-extent continuation)
671
            (ignore domain-predicate revision-predicate))
672
   (if (or event-predicate (consp quad-patterns))
673
       ;; if event indices are intended
674
       (let* ((subject 0)
675
             (context 0)
676
             (identifier 0)
677
             (predicates (repository-time-series-predicate-ids database))
678
             (solution-vector (make-array (+ 3 (length predicates)) :initial-element 0))
679
              (quad-pattern (copy-seq (first quad-patterns))))
680
         (setf (aref quad-pattern 3) 0)
681
         (flet ((construct-solution (%tsiquad)
682
                  ;; accept each matched quad, collate by
683
                  (let ((next-subject (spocq.i::%tsiquad-subject %tsiquad))
684
                        (next-context (spocq.i::%tsiquad-context %tsiquad))
685
                        (next-identifier (database-key-identifier database %tsiquad))
686
                        (predicate-index (position (spocq.i::%tsiquad-predicate %tsiquad) predicates)))
687
                    (cond (predicate-index
688
                           (unless (and (= subject next-subject) (= context next-context)
689
                                        ;; needs to be a byte comparison for uuid pointers
690
                                        (equalp identifier next-identifier))
691
                             (unless (= subject 0)
692
                               (funcall continuation solution-vector))
693
                             (setf subject next-subject)
694
                             (setf context next-context)
695
                             (setf identifier next-identifier)
696
                             (fill solution-vector 0)
697
                             (setf (aref solution-vector 0) identifier
698
                                   (aref solution-vector 1) context
699
                                   (aref solution-vector 2) subject))
700
                           (setf (aref solution-vector (+ 3 predicate-index)) (spocq.i::%tsiquad-object %tsiquad)))
701
                          (t
702
                           (log-warn "unregistered time-series predicate: ~s" (spocq.i::%tsiquad-predicate %tsiquad)))))))
703
           (declare (dynamic-extent #'construct-solution))
704
           (apply #'call-next-method #'construct-solution database quad-pattern args)
705
           (unless (= subject 0)
706
             (funcall continuation solution-vector))))
707
       (call-next-method)))
708
 
709
 (defgeneric database-key-identifier (database index-key)
710
   (:method ((database rlmdb::ordinal-time-series-database) (%tsoquad t))
711
     (spocq.i::%tsoquad-ordinal %tsoquad))
712
   (:method ((database rlmdb::timestamp-time-series-database) (%tstquad t))
713
     (spocq.i::%tstquad-time %tstquad))
714
   (:method ((database rlmdb::identifier-time-series-database) (%tsiquad t))
715
     (spocq.i::%tsiquad-uuid %tsiquad)))
716
 
717
 (defmethod database-key-event ((database rlmdb::ordinal-time-series-database) %key)
718
   (%tsoquad-ordinal %key))
719
 (defmethod database-key-event ((database rlmdb::timestamp-time-series-database) %key)
720
   (%tstquad-time %key))
721
 (defmethod database-key-event ((database rlmdb::identifier-time-series-database) %key)
722
   ;;;!!! needs to extract the vector
723
   (%tsiquad-uuid %key))
724
 
725
 |#
726