Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/rlmdb/shard-term.lisp
| Kind | Covered | All | % |
| expression | 355 | 980 | 36.2 |
| branch | 29 | 56 | 51.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.rdf.lmdb.implementation; -*-
2
;;; (load "patches/shard-term.lisp")
4
;;; implement direct access to persistent term definitions
10
(cffi:defcenum (shard-term-type :uint8)
12
(:node 1) ;; blank node
13
(:uri 2) ;; URI/IRI reference
14
(:string 3) ;; plain literal
15
(:literal 4) ;; datatyped literal
16
(:boolean 5) ;; xsd:boolean
17
(:integer 6) ;; xsd:integer
18
(:decimal 7) ;; xsd:decimal
19
(:float 8) ;; xsd:float
20
(:double 9) ;; xsd:double
21
(:datetime 10) ;; xsd:dateTime
22
(:date 11) ;; xsd:date
23
(:time 12)) ;; xsd:time
25
(cffi:defcenum (shard-node-subtype :uint8)
27
;; blank node subtypes:
33
(cffi:defcenum (shard-string-subtype :uint8)
39
(cffi:defcenum (shard-decimal-subtype :uint8)
41
;; blank node subtypes:
44
(cffi:defbitfield (shard-term-flags :uint8)
47
(cffi:defcstruct shard-term-uri
48
(string-offset :uint32))
50
(cffi:defcstruct shard-node-gensym
51
(prefix :uchar :count 4)
54
(cffi:defcunion shard-term-node
56
(gensym (:struct shard-node-gensym))
57
(label :uchar :count 8)
58
(label-offset :uint32))
60
(cffi:defcstruct shard-term-string
61
(value-offset :uint32)
62
(language-offset :uint32))
64
(cffi:defcstruct shard-term-literal
65
(value-offset :uint32)
66
(datatype-offset :uint32))
68
(cffi:defcstruct shard-term-decimal
72
(cffi:defcunion shard-term-subtype
73
(node-subtype shard-node-subtype)
74
(decimal-subtype shard-decimal-subtype)
75
(string-subtype shard-string-subtype))
78
(cffi:defcunion shard-term-data
79
(uri (:struct shard-term-uri))
80
(node (:union shard-term-node))
81
(string (:struct shard-term-string))
82
(literal (:struct shard-term-literal))
85
(decimal (:struct shard-term-decimal))
90
(cffi:defcstruct (shard-term :size 12) ;; the size is 12, not 16 (20210716 mgr)
91
(type shard-term-type)
92
(subtype (:union shard-term-subtype))
93
(flags shard-term-flags)
95
(data (:union shard-term-data) :offset 4))
97
(cffi:defcstruct shard-triple
98
(subject-number :int32)
99
(predicate-number :int32)
100
(object-number :int32))
102
(cffi:defcstruct shard-quad
103
(subject-number :int32)
104
(predicate-number :int32)
105
(object-number :int32)
106
(context-number :int32))
108
(cffi:defcstruct shard-term-key
109
(sha1 :uint8 :count 40))
112
;;; define accessors for the fields in actual use
113
(defun %shard-term-type (%term)
114
(cffi:foreign-slot-value %term '(:struct shard-term) 'type))
115
(define-compiler-macro %shard-term-type (%term)
116
`(cffi:foreign-slot-value ,%term '(:struct shard-term) 'type))
118
(defun %shard-term-data (%term)
119
(cffi:foreign-slot-pointer %term '(:struct shard-term) 'data))
120
(define-compiler-macro %shard-term-data (%term)
121
`(cffi:foreign-slot-pointer ,%term '(:struct shard-term) 'data))
123
(defun %shard-term-options (%term)
124
(cffi:foreign-slot-value %term '(:struct shard-term) 'options))
125
(define-compiler-macro %shard-term-options (%term)
126
`(cffi:foreign-slot-value ,%term '(:struct shard-term) 'options))
128
(defun %shard-term-subtype-node-subtype (%term)
129
(cffi:foreign-slot-value (cffi:foreign-slot-value %term '(:struct shard-term) 'subtype)
130
'(:union shard-term-subtype) 'node-subtype))
131
(define-compiler-macro %shard-term-subtype-node-subtype (%term)
132
`(cffi:foreign-slot-value (cffi:foreign-slot-value ,%term '(:struct shard-term) 'subtype)
133
'(:union shard-term-subtype) 'node-subtype))
135
(defun %shard-term-data-node-genid (%data)
136
(cffi:foreign-slot-value %data '(:union shard-term-node) 'genid))
137
(define-compiler-macro %shard-term-data-node-genid (%data)
138
`(cffi:foreign-slot-value ,%data '(:union shard-term-node) 'genid))
140
(defun %shard-term-data-node-gensym-prefix (%data)
141
(cffi:foreign-slot-pointer (cffi:foreign-slot-pointer %data '(:union shard-term-node) 'gensym)
142
'(:struct shard-node-gensym) 'prefix))
143
(define-compiler-macro %shard-term-data-node-gensym-prefix (%data)
144
`(cffi:foreign-slot-pointer (cffi:foreign-slot-pointer ,%data '(:union shard-term-node) 'gensym)
145
'(:struct shard-node-gensym) 'prefix))
147
(defun %shard-term-data-node-gensym-suffix (%data)
148
(cffi:foreign-slot-value (cffi:foreign-slot-pointer %data '(:union shard-term-node) 'gensym)
149
'(:struct shard-node-gensym) 'suffix))
150
(define-compiler-macro %shard-term-data-node-gensym-suffix (%data)
151
`(cffi:foreign-slot-value (cffi:foreign-slot-pointer ,%data '(:union shard-term-node) 'gensym)
152
'(:struct shard-node-gensym) 'suffix))
154
(defun %shard-term-data-node-label (%data)
155
(cffi:foreign-slot-pointer %data '(:union shard-term-node) 'label))
156
(define-compiler-macro %shard-term-data-node-label (%data)
157
`(cffi:foreign-slot-pointer ,%data '(:union shard-term-node) 'label))
160
(defun %shard-term-data-node-label-offset (%data)
161
(cffi:foreign-slot-value %data '(:union shard-term-node) 'label-offset))
162
(define-compiler-macro %shard-term-data-node-label-offset (%data)
163
`(cffi:foreign-slot-value ,%data '(:union shard-term-node) 'label-offset))
166
(defun %shard-term-data-uri-string-offset (%data)
167
(cffi:foreign-slot-value %data '(:struct shard-term-uri) 'string-offset))
168
(define-compiler-macro %shard-term-data-node-string-offset (%data)
169
`(cffi:foreign-slot-value ,%data '(:struct shard-term-uri) 'string-offset))
171
(defun %shard-term-subtype-string-subtype (%term)
172
(cffi:foreign-slot-value (cffi:foreign-slot-value %term '(:struct shard-term) 'subtype)
173
'(:union shard-term-subtype) 'string-subtype))
174
(define-compiler-macro %shard-term-subtype-string-subtype (%term)
175
`(cffi:foreign-slot-value (cffi:foreign-slot-value ,%term '(:struct shard-term) 'subtype)
176
'(:union shard-term-subtype) 'string-subtype))
178
(defun %shard-term-data-string-value-offset (%data)
179
(cffi:foreign-slot-value %data '(:struct shard-term-string) 'value-offset))
180
(define-compiler-macro %shard-term-data-string-value-offset (%data)
181
`(cffi:foreign-slot-value ,%data '(:struct shard-term-string) 'value-offset))
183
(defun %shard-term-data-string-language-offset (%data)
184
(cffi:foreign-slot-value %data '(:struct shard-term-string) 'language-offset))
185
(define-compiler-macro %shard-term-data-string-language-offset (%data)
186
`(cffi:foreign-slot-value ,%data '(:struct shard-term-string) 'language-offset))
188
(defun %shard-term-data-literal-value-offset (%data)
189
(cffi:foreign-slot-value %data '(:struct shard-term-literal) 'value-offset))
190
(define-compiler-macro %shard-term-data-literal-value-offset (%data)
191
`(cffi:foreign-slot-value ,%data '(:struct shard-term-literal) 'value-offset))
193
(defun %shard-term-data-literal-datatype-offset (%data)
194
(cffi:foreign-slot-value %data '(:struct shard-term-literal) 'datatype-offset))
195
(define-compiler-macro %shard-term-data-literal-datatype-offset (%data)
196
`(cffi:foreign-slot-value ,%data '(:struct shard-term-literal) 'datatype-offset))
199
(macrolet ((def-data-field-accessor (field)
200
(let ((name (cons-symbol *package* :%shard-term-data- field)))
203
(cffi:foreign-slot-value %data '(:union shard-term-data) ',field))
204
(define-compiler-macro ,name (%data)
205
(list 'cffi:foreign-slot-value %data ''(:union shard-term-data) '',field))))))
206
(def-data-field-accessor boolean)
207
(def-data-field-accessor double)
208
(def-data-field-accessor float)
209
(def-data-field-accessor integer)
210
(def-data-field-accessor time)
213
(defun %shard-term-subtype-decimal-subtype (%term)
214
(cffi:foreign-slot-value (cffi:foreign-slot-value %term '(:struct shard-term) 'subtype)
215
'(:union shard-term-subtype) 'decimal-subtype))
216
(define-compiler-macro %shard-term-subtype-decimal-subtype (%term)
217
`(cffi:foreign-slot-value (cffi:foreign-slot-value ,%term '(:struct shard-term) 'subtype)
218
'(:union shard-term-subtype) 'decimal-subtype))
220
(defun %shard-term-data-decimal-integer (%data)
221
(cffi:foreign-slot-value %data '(:struct shard-term-decimal) 'integer))
222
(define-compiler-macro %shard-term-data-decimal-integer (%data)
223
`(cffi:foreign-slot-value ,%data '(:struct shard-term-decimal) 'integer))
225
(defun %shard-term-data-decimal-fraction (%data)
226
(cffi:foreign-slot-value %data '(:struct shard-term-decimal) 'fraction))
227
(define-compiler-macro %shard-term-data-decimal-fraction (%data)
228
`(cffi:foreign-slot-value ,%data '(:struct shard-term-decimal) 'fraction))
233
(defun %strnlen (%string maximum)
234
"return the number of bytes before a null up to the maximum"
235
(loop for i below maximum
236
when (zerop (cffi:mem-aref %string :uint8 i))
238
finally (return maximum)))
240
(defun foreign-nstring-to-lisp (%string maximum)
241
(cffi:foreign-string-to-lisp %string :count (%strnlen %string maximum)))
243
(defun lisp-to-foreign-nstring (string %string maximum)
244
(cffi:lisp-string-to-foreign string %string maximum))
246
(defmacro with-shard-term-record ((record) &body body)
247
`(cffi:with-foreign-object (,record 'shard-term) ,@body))
251
(defparameter *term-segment-pathname* #p"/srv/dydra/storage/terms")
252
(defun mmap-file (path)
253
(let ((fd (osicat-posix:open path (logior osicat-posix:o-rdonly))))
255
(let* ((size (osicat-posix:stat-size (osicat-posix:fstat fd)))
256
(addr (osicat-posix:mmap (cffi:null-pointer) size
257
(logior osicat-posix:prot-read)
258
; (logior osicat-posix:map-private)
259
(logior osicat-posix:map-shared)
262
(osicat-posix:close fd))))
263
(defun mremap-file (path old-address old-size)
264
(let ((fd (osicat-posix:open path (logior osicat-posix:o-rdonly))))
266
(let* ((size (osicat-posix:stat-size (osicat-posix:fstat fd))))
267
(cond ((= size old-size)
268
(values old-address old-size nil))
270
(let ((addr (osicat-posix:mremap old-address old-size size
271
(logior OSICAT-POSIX:MREMAP-MAYMOVE))))
272
(values addr size t)))))
273
(osicat-posix:close fd))))
275
(defparameter *term-record-size* (load-time-value (cffi::foreign-type-size '(:struct shard-term))))
276
(defparameter *term-record-count* nil)
277
(defparameter *term-segment* nil)
278
(defparameter *term-segment-size* nil)
279
(flet ((update-segment-parameters (addr size)
280
(setf *term-record-count* (/ size *term-record-size*))
281
(assert (typep *term-record-count* '(integer 1)) ()
282
"term-segment: invalid term segment size: ~s" size)
283
(setf *term-segment-size* size
284
*term-segment* addr)))
285
(defun term-segment ()
287
(multiple-value-bind (addr size)
288
(mmap-file *term-segment-pathname*)
289
(update-segment-parameters addr size))))
290
(defun remap-term-segment ()
292
(multiple-value-bind (addr size remapped?)
293
(mremap-file *term-segment-pathname* *term-segment* *term-segment-size*)
295
(values (update-segment-parameters addr size) t))
298
(defun term-segment-size ()
299
(unless *term-segment-size*
303
(defun %term-record-count ()
304
(unless *term-record-count*
307
(defun term-record-count ()
308
(%term-record-count))
310
(defun term-record-size ()
313
(defun %fetch-term-record (term-number)
314
(declare (type fixnum term-number))
315
(flet ((locate-term ()
316
(when (< term-number (term-record-count))
317
(let* ((%term-segment (term-segment)))
318
(declare (type cffi-sys:foreign-pointer %term-segment))
319
;; terms start right at the beginning without an offset (20210716 mgr)
320
;; the first term record is the null_record, then comes the term with term number 1
321
(cffi:mem-aptr %term-segment '(:struct shard-term) term-number)))))
323
(multiple-value-bind (%term-segment remapped?)
325
(declare (ignore %term-segment))
326
(cond ((and remapped? (locate-term)))
328
(cl:error "%fetch-term-record: invalid term number: ~s: > ~s"
329
term-number (term-record-count))))))))
331
(cffi:defcfun ("_ZN5dydra4term5countEv" %%term-record-count) :int64 )
332
(cffi:defcfun ("_ZN5dydra4term12fetch_recordEi" %%fetch-term-record) :pointer (term-id :int32))
337
(cffi:defcfun ("_ZN5dydra4term5countEv" %term-record-count) :int64 )
338
(cffi:defcfun ("_ZN5dydra4term12fetch_recordEi" %fetch-term-record) :pointer (term-id :int32))
341
(defparameter rlmdb:*wildcard-term-number* rdfcache:*wildcard-term-number*)
342
(defparameter rlmdb:*all-context-number* rdfcache:*all-context-number*)
343
(defparameter rlmdb:*default-context-number* rdfcache:*default-context-number*)
344
(defparameter rlmdb:*named-context-number* rdfcache:*named-context-number*)
346
(defun rlmdb:shard-term-fetch (term-number)
349
(%fetch-term-record spocq.i::*true-default-context-term-number*))
351
(%fetch-term-record spocq.i::*true-named-context-term-number*))
352
(0 ;; this means that, if an unbound value gets here, it is mapped to <urn:dydra:all>
353
(%fetch-term-record spocq.i::*true-all-context-term-number*))
355
(%fetch-term-record term-number))))
357
(defun shard-term-value (term-number)
358
(declare (type fixnum term-number))
359
(term-record-value (shard-term-fetch term-number)))
361
(defun rlmdb:term-value (term-number)
362
(rlmdb:term-number-value term-number))
364
(defun rlmdb:term-number-value (term-number)
365
"Return the term object associated with the number in the current term shard.
366
Handle special cases for graph names and unbound.
367
Probe next the current cache.
368
If it is unknown, instantiate the object from the stored description,
369
set its number if it is an object and cache it.
370
Recognize ephemeral term numbers and non-instance values
371
Return the term object."
372
(if (= term-number 0)
373
(load-time-value (spocq:make-unbound-variable nil))
374
(or (get-registry term-number *store->spocq-term-registry*)
375
(let ((object (shard-term-value term-number)))
376
(cond ((and (spocq:term-p object) (> term-number 0))
377
(setf (spocq:term-id object) term-number)
378
(setf (get-registry term-number *store->spocq-term-registry*) object))
380
(setf (get-registry term-number *store->spocq-term-registry*) object))
384
(defun term-record-value (%term)
385
"Extract the object representation from the term record.
386
Atomic values - numbers and strings, are returned as such.
387
Term structures for which the stored representation does not readily identify with the lexical for are returned directly.
388
URI, blank node and non-native literals are interned based on the lexical components, to return the interned instance.
390
!!! this presumes that a string database is dynamically apparent. if not, it will fail.
391
!!! the known cases are extend, filter and order. if others arise they will need similar treatment.
392
!!! encoding follows a different logic, where each case establishes its own string database and
393
!!! endeavours to encode directly to a stream without interning."
394
(let* ((term-type (rlmdb:%shard-term-type %term))
395
(%term-data (rlmdb:%shard-term-data %term)))
396
(declare (type cffi-sys:foreign-pointer %term)
397
(type symbol term-type)
398
(type cffi-sys:foreign-pointer %term-data))
402
(case (rlmdb:%shard-term-subtype-node-subtype %term)
404
(spocq.i::intern-term-aspects :node
405
(format nil "genid~d" (rlmdb:%shard-term-data-node-genid %term-data))
409
(spocq.i::intern-term-aspects :node
411
(foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-gensym-prefix %term-data) 4)
412
(rlmdb:%shard-term-data-node-gensym-suffix %term-data))
416
(spocq.i::intern-term-aspects :node
417
(foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-label %term-data) 8)
421
(spocq.i::intern-term-aspects :node
422
(rlmdb:shard-string-fetch (rlmdb:%shard-term-data-node-label-offset %term-data))
426
(let ((lexical-form (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-uri-string-offset %term-data))))
427
(spocq.i::intern-term-aspects :uri lexical-form nil nil)))
429
(case (rlmdb:%shard-term-subtype-string-subtype %term)
431
(foreign-nstring-to-lisp %term-data 8))
433
(let* ((string (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-string-value-offset %term-data)))
434
(language-offset (rlmdb:%shard-term-data-string-language-offset %term-data))
435
(language-tag (when (plusp language-offset) (rlmdb:shard-string-fetch language-offset))))
437
(spocq:make-plain-literal string language-tag)
440
(let ((lexical-form (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-literal-value-offset %term-data)))
441
(datatype-string (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-literal-datatype-offset %term-data))))
442
(if (equal datatype-string "http://www.w3.org/2001/XMLSchema#string")
444
(spocq.i::intern-term-aspects :literal lexical-form datatype-string nil))))
446
;; must return it directly to avoid anomolous appearances
447
(if (rlmdb:%shard-term-data-boolean %term-data)
448
spocq.a:|true| spocq.a:|false|))
450
(rlmdb:%shard-term-data-integer %term-data))
452
(case (rlmdb:%shard-term-subtype-decimal-subtype %term)
454
(let* ((options (rlmdb:%shard-term-options %term))
455
(minusp (zerop (logand options #x01)))
456
(scale (ash options -1))
457
(value (rlmdb:%shard-term-data-integer %term-data)))
458
(when minusp (setf value (- value)))
459
(setf scale (if (zerop value) 1 (expt 10 scale)))
460
(when (plusp scale) (setf value
461
#+sbcl (sb-kernel::%make-ratio value scale)
462
#-sbcl (/ value scale)))
465
(let* ((integer (rlmdb:%shard-term-data-decimal-integer %term-data))
466
(fraction (rlmdb:%shard-term-data-decimal-fraction %term-data))
467
(scale (expt 10 (floor (log (1+ fraction) 10)))))
468
(when (zerop fraction) (setf scale 1))
469
(+ integer #+sbcl (sb-kernel::%make-ratio fraction scale) #-sbcl (/ fraction scale))))))
471
(rlmdb:%shard-term-data-float %term-data))
473
(rlmdb:%shard-term-data-double %term-data))
474
;; the identity relation among native literals requires equalp and/or
475
;; internal value comparison rather than eq, beacuse the interning process
476
;; is based on lexical form, rather than internal representation
478
(spocq.i::timeline-location-date-time (rlmdb:%shard-term-data-time %term-data)))
480
(spocq.i::timeline-location-date (rlmdb:%shard-term-data-time %term-data)))
482
(spocq.i::timeline-location-time (rlmdb:%shard-term-data-time %term-data)))
485
(cl:error "term-record-value: anomalous term : ~a (~a): ~a"
487
(with-output-to-string (stream) (dump-term-record %term :stream stream))))))
490
(defparameter *blank-node-label-scanner*
491
(cl-ppcre:create-scanner `(:sequence :start-anchor
492
(:alternation (:sequence (:FLAGS :CASE-INSENSITIVE-P) "GENID" (:register (:greedy-repetition 1 nil :digit-class)))
493
(:sequence (:register (:greedy-repetition 1 4 (:inverted-char-class :digit-class)))
494
(:register (:greedy-repetition 1 12 :digit-class)))
495
(:register (:sequence :word-char-class (:greedy-repetition 1 nil :word-char-class))))
498
(macrolet ((def-regex-parser (name (parameter &optional (required t)) &rest args)
499
(let ((documentation (when (stringp (first args)) (pop args)))
500
(scanner (pop args)))
501
`(defgeneric ,name (,parameter &key junk-allowed)
502
,@(when documentation `((:documentation ,documentation)))
503
(:method ((,parameter string) &key (junk-allowed ,(not required)))
504
(multiple-value-bind (parse registers) (cl-ppcre:scan-to-strings ,scanner ,parameter)
507
(apply #'values (loop for element across registers collect (when (plusp (length element)) element))))
511
(cl:error ,(format nil "~a: invalid value: ~~s" name) ,parameter)))))
512
(:method ((,parameter spocq:iri) &rest args)
513
(declare (dynamic-extent args))
514
(apply #',name (spocq:iri-lexical-form ,parameter) args))
515
(:method ((,parameter puri:uri) &rest args)
516
(declare (dynamic-extent args))
517
(apply #',name (spocq.i::iri-lexical-form ,parameter) args))
518
(:method ((,parameter t) &key (junk-allowed ,(not required)))
520
(cl:error ,(format nil "~a: invalid value: ~~s" name) ,parameter))
522
(def-regex-parser parse-blank-node-label (label nil)
523
"Return the elements of a blank node label"
524
*blank-node-label-scanner*)
525
;; (parse-blank-node-label "genid1")
526
;; (parse-blank-node-label "asdf1")
527
;; (parse-blank-node-label "asdf")
528
;; (parse-blank-node-label "asdfqwerty")
531
(defun string-dictionary-put (string)
532
(rlmdb::string-dictionary-put (rlmdb:string-database) string))
534
;;;!!! a place-holder
535
(defun rlmdb:value-term-number (object &key (if-does-not-exist :create))
536
(case if-does-not-exist
537
(:create (spocq.i::rdfcache-object-term-number *transaction* object))
538
(t (or (spocq.i::rdfcache-lookup-object-term-number object)
539
(case if-does-not-exist
540
(:error (error "value-term-number: term not found: ~s" object))
542
if-does-not-exist))))))
544
(defun set-term-record-value (object %shard-term)
545
(let ((%term-data (rlmdb:%shard-term-data %shard-term)))
548
(multiple-value-bind (genid prefix suffix string)
549
(parse-blank-node-label (spocq:blank-node-label object))
551
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-node) 'genid) (parse-integer genid)))
553
(lisp-to-foreign-nstring prefix
554
(cffi:foreign-slot-pointer (cffi:foreign-slot-pointer %term-data '(:union shard-term-node) 'gensym)
555
'(:struct shard-node-gensym) 'prefix)
557
(setf (cffi:foreign-slot-value (cffi:foreign-slot-pointer %term-data '(:union shard-term-node) 'gensym)
558
'(:struct shard-node-gensym) 'suffix)
559
(parse-integer suffix)))
560
((<= (length string) 8)
561
(lisp-to-foreign-nstring string
562
(cffi:foreign-slot-pointer %term-data '(:union shard-term-node) 'label)
565
(let ((string-id (string-dictionary-put string)))
566
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-node) 'label-offset)
569
(if (spocq.i::iri-p object)
570
(let* ((lexical-form (spocq.i::iri-lexical-form object))
571
(string-id (string-dictionary-put lexical-form)))
572
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-uri) 'string-offset) string-id))
573
(cl:error "set-term-record-value: invalid iri term: ~s" object)))
575
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :iri)
576
(let* ((lexical-form (spocq::iri-lexical-form object))
577
(string-id (string-dictionary-put lexical-form)))
578
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-uri) 'string-offset) string-id)))
581
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :string)
582
(cond ((<= (length object) 8)
583
(setf (cffi:foreign-slot-value (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'subtype)
584
'(:union shard-term-subtype) 'string-subtype)
586
(lisp-to-foreign-nstring %term-data 8 object))
588
(setf (cffi:foreign-slot-value (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'subtype)
589
'(:union shard-term-subtype) 'string-subtype)
591
(let ((string-id (string-dictionary-put object)))
592
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-string) 'value-offset)
595
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :string)
596
(let* ((string (spocq:plain-literal-lexical-form object))
597
(string-id (string-dictionary-put string))
598
(language (spocq:plain-literal-language-tag object))
599
(language-id (if language (string-dictionary-put language) 0)))
600
(setf (cffi:foreign-slot-value (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'subtype)
601
'(:union shard-term-subtype) 'string-subtype)
603
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-string) 'value-offset)
605
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-string) 'language-offset) language-id)))
608
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :boolean)
609
;; must return it directly to avoid anomolous appearances
610
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'boolean) (spocq:boolean-value object) ))
613
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :integer)
614
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'integer) object))
617
(let* ((minus (cond ((minusp object) (setf object (- object)) 1) (t 0)))
618
(string (let ((*read-default-float-format* 'single-float))
619
(format nil "~f" (float object 1.0s0))))
620
(dot (position #\. string))
621
(scale (- (length string) dot))
622
(options (+ (ash scale 1) minus))
623
(value (floor (abs (* object (expt 10 scale))))))
624
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :decimal)
625
(setf (cffi:foreign-slot-value (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'subtype)
626
'(:union shard-term-subtype) 'decimal-subtype)
628
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'options) options)
629
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'integer) value)))
632
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :float)
633
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'float) object))
635
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :float)
636
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'float) (spocq::float-value object)))
639
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :double)
640
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'double) object))
642
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :double)
643
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'double) (spocq::double-value object)))
646
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :datetime)
647
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'time) (spocq:temporal-timeline-location object)))
649
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :date)
650
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'time) (spocq:temporal-timeline-location object)))
652
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :time)
653
(setf (cffi:foreign-slot-value %term-data '(:union shard-term-data) 'time) (spocq:temporal-timeline-location object)))
656
(let* ((lexical-form (spocq:literal-lexical-form object))
657
(lexical-form-id (string-dictionary-put lexical-form))
658
(datatype-string (spocq:literal-datatype-uri object))
659
(datatype-id (string-dictionary-put datatype-string)))
660
(setf (cffi:foreign-slot-value %shard-term '(:struct shard-term) 'type) :literal)
661
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-literal) 'datatype-offset) datatype-id)
662
(setf (cffi:foreign-slot-value %term-data '(:struct shard-term-literal) 'value-offset) lexical-form-id)))
665
(cl:error "set-term-record-value: anomalous term value : ~s"
668
(defun rlmdb:term-timeline-location (term-number)
669
(let* ((%term (shard-term-fetch term-number))
670
(term-type (rlmdb:%shard-term-type %term))
671
(%term-data (rlmdb:%shard-term-data %term)))
672
(declare (type cffi-sys:foreign-pointer %term)
673
(type symbol term-type)
674
(type cffi-sys:foreign-pointer %term-data))
676
((:datetime :date :time)
677
(cffi:foreign-slot-value %term-data '(:union shard-term-data) 'time)))))
679
(defun shard-term-timeline-location (term-number)
680
(rlmdb:term-timeline-location term-number))
683
(defun rlmdb:term-timestamp (term-number &optional (error-p nil))
684
"Return the identified UNIX timestamp for a term of any temporal type.
685
Other types signal a type error."
686
(let* ((%term (or (shard-term-fetch term-number)
688
(cl:error "rlmdb:term-timestamp term not found ~s" term-number)
689
(return-from rlmdb:term-timestamp nil))))
690
(term-type (rlmdb:%shard-term-type %term))
691
(%term-data (rlmdb:%shard-term-data %term)))
692
(declare (type cffi-sys:foreign-pointer %term)
693
(type symbol term-type)
694
(type cffi-sys:foreign-pointer %term-data))
696
((:datetime :date :time)
697
(cffi:foreign-slot-value %term-data '(:union shard-term-data) 'time))
698
(:literal ;; fails is not temporal
699
(spocq.i:temporal-timeline-location (term-record-value %term)))
701
(spocq.e:argument-type-error :operator 'shard-term-timestamp :expected-type '(unsigned-byte 64)
702
:datum (list term-number term-type))))))
704
(defun shard-term-timestamp (term-number &optional (error-p nil))
705
(rlmdb:term-timestamp term-number error-p))
708
(defun rlmdb:term-iri-namestring (term-number &optional (error-p t))
709
(let* ((%term (or (rlmdb:shard-term-fetch term-number)
711
(cl:error "encode-json-ld-id: term not found ~s" term-number)
712
(return-from rlmdb:term-iri-namestring nil)))))
713
(declare (type cffi:foreign-pointer %term))
714
(let ((term-type (rlmdb:%shard-term-type %term))
715
(rlmdb:%shard-term-data (rlmdb:%shard-term-data %term)))
716
(declare (type symbol term-type)
717
(type cffi:foreign-pointer %shard-term-data))
720
(rlmdb:shard-string-fetch (rlmdb:%shard-term-data-uri-string-offset %shard-term-data)))
724
(defun shard-term-iri-namestring (term-number &optional (error-p t))
725
(rlmdb:term-iri-namestring term-number error-p))
728
(defun rlmdb:term-is-blank-node (term-number &optional (error-p nil))
729
(let* ((%term (or (shard-term-fetch term-number)
731
(cl:error "term-is-blank-node: term not found ~s" term-number)
732
(return-from rlmdb:term-is-blank-node nil)))))
733
(declare (type cffi:foreign-pointer %term))
734
(let ((term-type (rlmdb:%shard-term-type %term)))
735
(declare (type symbol term-type))
742
(defun shard-term-is-blank-node (term-number &optional (error-p nil))
743
(rlmdb:term-is-blank-node term-number error-p))
746
(defun rlmdb:term-is-iri (term-number &optional (error-p nil))
747
(let* ((%term (or (shard-term-fetch term-number)
749
(cl:error "term-is-iri: term not found ~s" term-number)
750
(return-from rlmdb:term-is-iri nil)))))
751
(declare (type cffi:foreign-pointer %term))
752
(let ((term-type (rlmdb:%shard-term-type %term)))
753
(declare (type symbol term-type))
760
(defun shard-term-is-iri (term-number &optional (error-p nil))
761
(rlmdb:term-is-iri term-number error-p))
764
(defun rlmdb:term-is-literal (term-number &optional (error-p nil))
765
(let* ((%term (or (shard-term-fetch term-number)
767
(cl:error "term-is-literal: term not found ~s" term-number)
768
(return-from rlmdb:term-is-literal nil)))))
769
(declare (type cffi:foreign-pointer %term))
770
(let ((term-type (rlmdb:%shard-term-type %term)))
771
(declare (type symbol term-type))
778
(defun shard-term-is-literal (term-number &optional (error-p nil))
779
(rlmdb:term-is-literal term-number error-p))
782
(defun rlmdb:term-type (term-number &optional (error-p nil))
783
(let* ((%term (or (shard-term-fetch term-number)
785
(cl:error "rlmdb:term-type: term not found ~s" term-number)
786
(return-from rlmdb:term-type nil)))))
787
(declare (type cffi:foreign-pointer %term))
788
(rlmdb:%shard-term-type %term)))
790
(defun shard-term-type (term-number &optional (error-p nil))
791
(rlmdb:term-type term-number error-p))
793
(defun rlmdb:term-string (term-number)
794
(let* ((%term (shard-term-fetch term-number))
795
(term-type (rlmdb:%shard-term-type %term))
796
(%term-data (rlmdb:%shard-term-data %term)))
797
(declare (type cffi-sys:foreign-pointer %term)
798
(type symbol term-type)
799
(type cffi-sys:foreign-pointer %term-data))
802
(case (cffi:foreign-slot-value (cffi:foreign-slot-value %term '(:struct shard-term) 'subtype)
803
'(:union shard-term-subtype) 'string-subtype)
805
(values (foreign-nstring-to-lisp %term-data 8)
808
(let* ((string (rlmdb:shard-string-fetch (cffi:foreign-slot-value %term-data '(:struct shard-term-string) 'value-offset)))
809
(language-offset (cffi:foreign-slot-value %term-data '(:struct shard-term-string) 'language-offset))
810
(language-tag (when (plusp language-offset) (rlmdb:shard-string-fetch language-offset))))
812
(values string language-tag)
815
(let ((datatype-string (rlmdb:shard-string-fetch (cffi:foreign-slot-value %term-data '(:struct shard-term-literal) 'datatype-offset))))
816
(when (equal datatype-string "http://www.w3.org/2001/XMLSchema#string")
817
(rlmdb:shard-string-fetch (cffi:foreign-slot-value %term-data '(:struct shard-term-literal) 'value-offset)))))
821
(defun shard-term-string (term-number)
822
(rlmdb:term-string term-number))
825
(defun rlmdb:term-language (term-number)
826
(let* ((%term (shard-term-fetch term-number))
827
(term-type (rlmdb:%shard-term-type %term))
828
(%term-data (rlmdb:%shard-term-data %term)))
829
(declare (type cffi-sys:foreign-pointer %term)
830
(type symbol term-type)
831
(type cffi-sys:foreign-pointer %term-data))
834
(case (cffi:foreign-slot-value (cffi:foreign-slot-value %term '(:struct shard-term) 'subtype)
835
'(:union shard-term-subtype) 'string-subtype)
839
(let* ((language-offset (cffi:foreign-slot-value %term-data '(:struct shard-term-string) 'language-offset)))
840
(when (plusp language-offset) (rlmdb:shard-string-fetch language-offset)))))))))
842
(defun shard-term-language (term-number)
843
(rlmdb:term-language term-number))
845
(defun rlmdb:term-datatype-id (term-number)
846
(let* ((%term (shard-term-fetch term-number))
847
(term-type (rlmdb:%shard-term-type %term))
848
(%term-data (rlmdb:%shard-term-data %term)))
849
(when (eq term-type :literal)
850
(rlmdb:%shard-term-data-literal-datatype-offset %term-data))))
853
(defun rlmdb:graph-term-number (term &key (allow-all nil))
854
"derive the graph term number specific for lmdb shards"
855
(cond ((member term '(nil :default |urn:dydra|:|default|))
856
rlmdb:*default-context-number*)
857
((member term '(t |urn:dydra|:|all|))
859
rlmdb:*all-context-number*
860
(error "invalid graph management argument: ~s" term)))
861
((eq term '|urn:dydra|:|named| )
863
rlmdb:*named-context-number*
864
(error "invalid graph management argument: ~s" term)))
865
((or (iri-p term) (spocq:blank-node-p term))
866
(rlmdb:value-term-number term))
868
(spocq.e::invalid-graph-error :identifier term))))
874
(defun rlmdb:term-elements (term-number)
875
(declare (type fixnum term-number))
876
(let* ((%term (shard-term-fetch term-number)))
878
(let ((term-type (rlmdb:%shard-term-type %term))
879
(%term-data (rlmdb:%shard-term-data %term)))
880
(declare (type cffi-sys:foreign-pointer %term)
881
(type symbol term-type)
882
(type cffi-sys:foreign-pointer %term-data))
883
(list* :type term-type
886
(case (rlmdb:%shard-term-subtype-node-subtype %term)
888
(list :genid (format nil "genid~d" (rlmdb:%shard-term-data-node-genid %term-data))))
890
(list :gensym (format nil "~a~d"
891
(foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-gensym-prefix %term-data) 4)
892
(rlmdb:%shard-term-data-node-gensym-suffix %term-data))))
894
(list :short-string (foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-label %term-data) 8)))
896
(list :value-string (rlmdb:%shard-term-data-node-label-offset %term-data)))
898
;everything is in-line
901
(list :value-string (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-uri-string-offset %term-data))))
903
(case (rlmdb:%shard-term-subtype-string-subtype %term)
905
(list :short-string (foreign-nstring-to-lisp %term-data 8)))
907
(list* :value-string (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-string-value-offset %term-data))
908
(let ((language-offset (rlmdb:%shard-term-data-string-language-offset %term-data)))
909
(when (plusp language-offset)
910
(list :language-string (rlmdb:shard-string-fetch language-offset))))))))
912
(list* :value-string (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-literal-value-offset %term-data))
913
(let ((datatype-offset (rlmdb:%shard-term-data-literal-datatype-offset %term-data)))
914
(when (plusp datatype-offset)
915
(list :datatype-string (rlmdb:shard-string-fetch datatype-offset))))))
917
(list :value (rlmdb:%shard-term-data-boolean %term-data)))
919
(list :value (rlmdb:%shard-term-data-integer %term-data)))
922
(rlmdb:%shard-term-data-decimal-integer %term-data)
923
(rlmdb:%shard-term-data-decimal-fraction %term-data)))
925
(list :value (rlmdb:%shard-term-data-float %term-data)))
927
(list :value (rlmdb:%shard-term-data-double %term-data)))
929
(list :value (rlmdb:%shard-term-data-time %term-data)))
931
(list :value (rlmdb:%shard-term-data-time %term-data)))
933
(list :value (rlmdb:%shard-term-data-time %term-data)))
935
(cl:error "term-elements: anomalous term : ~a" (with-output-to-string (stream) (dump-term-record term-number :stream stream))))))))))
937
(defun shard-term-elements (term-number)
938
(rlmdb:term-elements term-number))
941
(defgeneric dump-term-record (term-designator &key stream)
942
(:method ((term-number integer) &rest args)
943
(apply #'dump-term-record (shard-term-fetch term-number) args))
944
(:method ((%record SB-SYS:SYSTEM-AREA-POINTER) &key (stream *standard-output*))
945
(format stream "[~{~2,'0x~^ ~}]"
946
(loop for i below 12 collect (cffi:mem-aref %record :uint8 i)))))
948
(defun describe-term-number (term-number)
949
(dump-term-record term-number)
950
(list* :term-number term-number
951
:term-number-object (shard-term-value term-number)
952
(multiple-value-bind (elements error) (ignore-errors (shard-term-elements term-number))
953
(or error elements))))
954
(defun describe-term (term)
955
(spocq.i::with-open-repository ("james/test" :write-only-p nil)
956
(let* ((term-number (rlmdb:value-term-number term)))
957
(dump-term-record term-number)
959
(describe-term-number term-number)))))
962
;;; (shard-term-value 1)
963
;;; (shard-term-value 1)
964
;;; (shard-term-elements 1)
965
;;; (dump-term-record 1)