Coverage report: /development/source/library/org/datagraph/spocq-shard/src/algebra/operators/basic-operators.lisp

KindCoveredAll%
expression59204 28.9
branch726 26.9
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 (:documentation "This file defines general operators for abstract sparql query (sse) s-expressions for
6
  the 'org.datagraph.spocq' RDF engine."
7
 
8
  (copyright
9
   "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
10
 
11
  (long-description
12
   "The file defines predicate, combination, construction and function operators for query solutions and
13
  statements.
14
 
15
  Solutions are modeled as property lists which pair the variable (the stem) to its bound value.
16
  In this form they can be supplied as keyword argument lists as well as subject to set operations.
17
 
18
  Statements are structures with one field for each term."))
19
 
20
 (defun spocq.e:merge (solution1 solution2)
21
   (let ((solution (copy-list solution1)))
22
     (loop for (var value) on solution2 by #'cddr
23
           do (setf (getf solution var) value))
24
     solution))
25
 
26
 (defun spocq.e:compatible? (solution1 solution2)
27
   "perez.2009 : Note that two mappings with disjoint domains are always 
28
 compatible, and that the empty mapping (i.e. the mapping with empty domain) is
29
 compatible with any other mapping."
30
   (or (null solution1)
31
       (null solution2)
32
       (loop for (var s2-value) on solution2 by #'cddr
33
             do (let ((s1-value (getf solution1 var solution1)))
34
                  (unless (or (eq s1-value solution1)
35
                              (eql s1-value s2-value)
36
                              (spocq.e:same-term s1-value s2-value))
37
                    (return nil)))
38
             finally (return t))))
39
 
40
 ; (spocq.e:compatible? '(?::|x| _::|a| ?::|mbox| "mb") '(?::|x| _::|b| ?::|name| "Alice"))
41
 
42
 (defgeneric spocq.e:equal (o1 o2)
43
   (:method ((o1 t) (o2 t))
44
     (spocq.e:same-term o1 o2))
45
   (:method ((solution1 cons) (solution2 cons))
46
     ;; test binding equivalence
47
     (and (= (length solution1) (length solution2))
48
          (loop for (var s2-value) on solution2 by #'cddr
49
                unless (let ((s1-value (getf solution1 var solution1)))
50
                         (spocq.e:equal s1-value s2-value))
51
                return nil
52
                finally (return t)))))
53
 
54
   
55
 (defun spocq.e:lessp (o1 o2)
56
   (let ((*enable-sort-precedence* t))
57
     (spocq.e:< o1 o2)))
58
 
59
 (defun spocq.e:greaterp (o1 o2)
60
   (let ((*enable-sort-precedence* t))
61
     (spocq.e:> o1 o2)))
62
 
63
 (defun compare-terms (term1 term2)
64
   (cond ((spocq.e:= term1 term2)
65
          0)
66
         ((spocq.e:< term1 term2)
67
          -1)
68
         (t
69
          1)))
70
 
71
 (defun compare-term (term1 term2)
72
   (compare-terms term1 term2))
73
 
74
 (defun compare-term-inverted (term1 term2)
75
   (compare-term term2 term1))
76
 (define-compiler-macro compare-term-inverted (term1 term2)
77
   `(compare-terms ,term2 ,term1))
78
 
79
 (defun compare-term-number (term-number1 term-number2)
80
   (or (rlmdb:term-compare term-number1 term-number2)
81
       (compare-term (term-number-object term-number1)
82
                     (term-number-object term-number2))))
83
 
84
 #+(or) ;; superceded by the shard version for short strings
85
 (defun compare-term-number (term-number1 term-number2)
86
   (if (= term-number1 0)
87
       (if (= term-number2 0)
88
           0
89
           -1)
90
       (if (= term-number2 0)
91
           1
92
           (or (dydra-ndk:term-compare term-number1 term-number2)
93
               (compare-term (term-number-object term-number1)
94
                             (term-number-object term-number2))))))
95
 #+(or)
96
 (defun compare-term-number (term-number1 term-number2)
97
   (let ((result (dydra-ndk:term-compare term-number1 term-number2)))
98
     #+(or)
99
     (format *trace-output* "~%~s ~s => ~d"
100
             (spocq::plain-literal-lexical-form (rlmdb:term-number-value term-number1))
101
             (spocq::plain-literal-lexical-form (rlmdb:term-number-value term-number2))
102
             result)
103
     (if (integerp result)
104
       result
105
       (compare-term (term-number-object term-number1)
106
                     (term-number-object term-number2)))))
107
 
108
 (defun compare-term-number-inverted (term-number1 term-number2)
109
   (compare-term-number term-number2 term-number1))
110
 (define-compiler-macro compare-term-number-inverted (term-number1 term-number2)
111
   `(compare-term-number ,term-number2 ,term-number1))
112
 
113
 
114
 
115
 (defgeneric spocq.e:cardinality (solution-field)
116
   (:method ((field list))
117
     (length field)))
118
 
119
 (defgeneric ebv (term)
120
   (:documentation "Given a TERM, return the cl:boolean effective boolean value.
121
     This canonicalizes t, nil, true, false in addition to the mapping implied by
122
     xsd:boolean. not that the rules for the latter[1,2] stipulate that anything which
123
     it does not implicitly cast to boolean is to be treated as an invalid arguement.
124
     ---
125
     [1] : http://www.w3.org/2009/sparql/docs/query-1.1/rq25#ebv
126
     [2] : http://www.w3.org/TR/xpath-functions-30/#func-boolean ")
127
 
128
   (:method ((term symbol))
129
     (cond ((or (eq term t) (iri-p term)) t)
130
           ((null term) nil)
131
           (t (call-next-method))))
132
 
133
   (:method ((term number))
134
     (not (zerop term)))
135
 
136
   (:method ((term float))
137
     (cond #+sbcl ((sb-ext:float-nan-p term) nil)
138
           ((or (eql term DOUBLE-FLOAT-NAN)
139
                (eql term SINGLE-FLOAT-NAN))
140
            nil)
141
           ((zerop term) nil)
142
           (t t)))
143
 
144
   (:method ((term spocq:boolean))
145
     (spocq:boolean-value term))
146
 
147
   (:method ((term string))
148
     (plusp (length term)))
149
 
150
   (:method ((term spocq:atomic-typed-literal))
151
     (ebv (literal-value term)))
152
 
153
   (:method ((term spocq:unbound-variable))
154
     (spocq.e:undefined-variable-error :name (spocq:unbound-variable-name term)))
155
 
156
   (:method ((term spocq:unsupported-typed-literal))
157
     (let ((type (spocq:unsupported-typed-literal-datatype-uri term)))
158
       (if (and (symbolp type)
159
                (or (eq type '|xsd|:|boolean|)
160
                    (ignore-errors (subtypep type 'spocq:number))))
161
         nil
162
         (call-next-method))))
163
 
164
   (:method ((term t))
165
     (invalid-argument-type ebv term boolean)))
166
 
167
 
168
 (defun type-sort-precedence (term)
169
   "return a ordinal for the given term type.
170
    the default yields an arbitrary function of the type name"
171
   (typecase term
172
     ((or null spocq:unbound-variable) 0)
173
     (spocq:blank-node 1)
174
     (iri 2)
175
     (spocq:plain-literal 3)
176
     ((or string spocq:string) 4)
177
     ((or boolean spocq:boolean) 5)
178
     ((or number spocq:number) 6)
179
     (spocq::gregorian 21)
180
     (spocq:day-Time-Duration 22)
181
     (spocq:year-Month-Duration 23)
182
     (spocq:duration 24)
183
     (spocq:date 25)
184
     (spocq:time 26)
185
     (spocq:date-time 27)
186
     (spocq:unsupported-typed-literal
187
      (+ 100 (sxhash (spocq:unsupported-typed-literal-datatype-uri term))))
188
     (t (+ 100 (sxhash (type-of term))))))
189
 
190
 #|
191
 typecase is faster
192
 ;;; (defun test-order (x &optional (count 1000000)) (dotimes (i count) (type-sort-precedence x)))
193
 ;;; (time (test-order (spocq:make-year-month-duration)))
194
 ;;; 0.051s
195
 
196
 (defun type-sort-precedence2 (term)
197
   (if term
198
       (get (type-of term) 'sort-precedence 100)))
199
 (setf (get 'spocq:year-Month-Duration 'sort-precedence) 8)
200
 
201
 ;;; (defun test-order2 (x &optional (count 1000000)) (dotimes (i count) (type-sort-precedence2 x)))
202
 ;;; (time (test-order2 (spocq:make-year-month-duration)))
203
 
204
   (typecase term
205
     ((or null spocq:unbound-variable) 0)
206
     (spocq:blank-node 1)
207
     (iri 2)
208
     (spocq:plain-literal 3)
209
     ((or string spocq:string) 4)
210
     (spocq:boolean 5)
211
     (spocq::gregorian 6)
212
     (spocq:day-Time-Duration 6)
213
     (spocq:year-Month-Duration 8)
214
     (t 4)))
215
 |#
216
 
217
 ;;;
218
 ;;; constructors
219
 
220
 (defmacro spocq.a:|triple| (subject predicate object)
221
   `(spocq.e:triple ,subject ,predicate ,object))
222
 
223
 (defun spocq.e:triple (subject predicate object) ;; also spocq:triple
224
   (make-triple :subject subject :predicate predicate :object object))
225
 
226
 (defmacro spocq.a:|quad| (subject predicate object graph)
227
   `(spocq.e:quad  ,subject ,predicate ,object ,graph))
228
 
229
 (defun spocq.e:quad (subject predicate object graph) ;; also spocq:quad
230
   (make-quad :subject subject :predicate predicate :object object :graph graph))
231
 
232
 
233
 (defmacro spocq.a:|list| (&rest args)
234
   `(list ,@args))
235
 
236
 #+(or)
237
 (progn
238
 
239
 (list (spocq.e:compatible? '(a 1 b 2) '(a 1))
240
       (spocq.e:compatible? '(b 2) '(a 2))
241
       (not  (spocq.e:compatible? '(a 1 b 2) '(a 2))))
242
 
243
 (list (equal (spocq.a:merge '(a 1 b 2) '(a 1)) '(a 1 b 2))
244
       (equal (spocq.a:merge '(b 2) '(a 2)) '(a 2 b 2))
245
       (equal (spocq.a:merge '(a 1 b 2) '(a 2)) '(a 2 b 2)))
246
 
247
 ;; canonical parses:
248
 bin/qparse --print=op "PREFIX : <http://example/>
249
  SELECT * 
250
  {
251
    GRAPH :g1 { ?x ?p ?v }
252
  }"
253
 
254
 )