Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/rlmdb/shard-term-compare.lisp

KindCoveredAll%
expression58124 46.8
branch1124 45.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")
3
 
4
 ;;; implement direct access to persistent term definitions
5
 
6
 (in-package :rlmdb.i)
7
 
8
 ;;; Shard data comparison
9
 ;;; initially just to handle the short strings
10
 
11
 
12
 (defun term-record-compare (%term1 %term2 term-number1 term-number2)
13
   ;; for this initial patch version, compare just the compact and pass the others through
14
   (declare (type cffi-sys:foreign-pointer %term1 %term2))
15
   (let* ((term-type1 (cffi:foreign-slot-value %term1 '(:struct shard-term) 'type))
16
          (term-type2 (cffi:foreign-slot-value %term2 '(:struct shard-term) 'type)))
17
     (declare (type symbol term-type1 term-type2))
18
     (unless (eq term-type1 term-type2)
19
       (return-from term-record-compare nil))
20
     (flet ((compare-strings (str1 str2) ;; should be byte-wise
21
              (cond ((string< str1 str2) -1)
22
                    ((string< str2 str1) 1)
23
                    (t 0))))
24
       (case term-type1
25
         (:node
26
          (flet ((term-label (%term)
27
                   (let ((%term-data (%shard-term-data %term)))
28
                     (declare (type cffi-sys:foreign-pointer %term-data))
29
                     (case (%shard-term-subtype-node-subtype %term)
30
                       (:node-genid
31
                        (format nil "genid~d" (%shard-term-data-node-genid %term-data)))
32
                       (:node-gensym
33
                        (format nil "~a~d"
34
                                (foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-gensym-prefix %term-data) 4)
35
                                (rlmdb:%shard-term-data-node-gensym-suffix %term-data)))
36
                       (:node-short
37
                        (foreign-nstring-to-lisp (rlmdb:%shard-term-data-node-label %term-data) 8))
38
                       ((:node-long :none)
39
                        (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-node-label-offset %term-data)))))))
40
            (compare-strings (term-label %term1) (term-label %term2))))
41
         (:string
42
          ;; if either is short, compare just the respective strings
43
          ;; unless the other has a language tag, in which case the do not compare
44
          (let* ((%term-data1 (%shard-term-data %term1))
45
                 (%term-data2 (%shard-term-data %term2))
46
                 (term-subtype1 (rlmdb:%shard-term-subtype-string-subtype %term1))
47
                 (term-subtype2 (rlmdb:%shard-term-subtype-string-subtype %term2)))
48
            (if (eq term-subtype1 :string-short)
49
                (if (eq term-subtype2 :string-short)
50
                    (compare-strings (foreign-nstring-to-lisp %term-data1 8)
51
                                     (foreign-nstring-to-lisp %term-data2 8))
52
                    (if (rlmdb:%shard-term-data-string-language-offset %term-data1)
53
                        nil
54
                        (compare-strings (foreign-nstring-to-lisp %term-data1 8)
55
                                         (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-string-value-offset %term-data2)))))
56
                (if (eq term-subtype2 :string-short)
57
                    (if (rlmdb:%shard-term-data-string-language-offset %term-data1)
58
                        nil
59
                        (compare-strings (rlmdb:shard-string-fetch (rlmdb:%shard-term-data-string-value-offset %term-data1))
60
                                         (foreign-nstring-to-lisp %term-data2 8)))
61
                    ;; if both are long continue wth the dydra-ndk version, which handles collation
62
                    (DYDRA-NDK:TERM-COMPARE term-number1 term-number2)))))
63
         ;; other types continue with the dydra-ndk version for more effecient decoding
64
         (t
65
          (DYDRA-NDK:TERM-COMPARE term-number1 term-number2))))))
66
 
67
 (defun rlmdb:term-compare (term-number1 term-number2)
68
   "Given a term number, use the stored elements (type, string, immediate value)
69
   to construct a _new_ term instance."
70
   (declare (type fixnum term-number1 term-number2))
71
   (cond ((= term-number1 term-number2)
72
          0)
73
         ((= term-number1 0)
74
          -1)
75
         ((= term-number2 0)
76
          1)
77
         ((or (= -1 term-number1) (= -1 term-number2)  )
78
          nil)
79
         (t
80
          (term-record-compare (shard-term-fetch term-number1) (shard-term-fetch term-number2)
81
                               term-number1 term-number2))))
82