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

KindCoveredAll%
expression248302 82.1
branch1524 62.5
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 the EXTEND operator for the 'org.datagraph.spocq' RDF engine."
6
 
7
  (copyright
8
   "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved."))
9
 
10
 
11
 (defmacro spocq.a:|extend| (field-expression variable value-expression &rest args &key count end offset start)
12
   "( ( solutionField variable RDFTerm ) solutionField )
13
 An EXTEND form extends each solution in its solution-field argument with an additional dimension
14
 in which the given variable is bound to the respective result of evaluating the given expression
15
 for each solution.
16
 If the evaluation fails, the variable remains unbound."
17
 
18
   (declare (ignore count end offset start))
19
   (apply #'macroexpand-extend field-expression variable value-expression args))
20
 
21
 (defmacro spocq.a::extend* (field-expression variable value-expression &rest args)
22
   `(spocq.a:|extend| ,(if (variable-p (first args))
23
                           `(spocq.a::extend* ,field-expression ,@args)
24
                           field-expression)
25
             ,variable ,value-expression))
26
 
27
 (defun macroexpand-extend (field-expression variable value-expression &rest args)
28
   (let* ((bindings ())
29
          (field-dimensions (expression-dimensions field-expression))
30
          (dcl `(declare (spocq.e:dimensions ,@field-dimensions)))
31
          (reference-dimensions ()))
32
     ;; consolidate the bindings
33
     ;; See [http://www.w3.org/TR/sparql11-query/#sparqlGrammar] wrt restrictions.
34
     (loop (when (assoc variable bindings)
35
             (spocq.e:redefined-variable-error :variables (list variable)
36
                                               :expression (mapcar #'first bindings)))
37
           (push (list variable value-expression) bindings)
38
           (if (extend-form-p field-expression)
39
             (destructuring-bind (next-field-expression next-variable next-bindings)
40
                                 (rest field-expression)
41
               (setf field-expression next-field-expression
42
                     variable next-variable
43
                     value-expression next-bindings))
44
             (return)))
45
     ;; propagate the dimension declaration
46
     (setf bindings (loop for (variable expression) in bindings
47
                      do (setf reference-dimensions (union reference-dimensions (expression-variables expression)))
48
                      collect (list variable
49
                                    (if (or (consp expression) (variable-p expression))
50
                                        `(locally ,dcl ,expression)
51
                                        expression))))
52
     (let ((sliced-expression (when args
53
                                (apply #'compute-expression-slice field-expression args))))
54
       ;; order should be inner-most first, sodo not reverse
55
       (if sliced-expression
56
           `(spocq.e:extend (spocq.e::with-reference-dimensions ,reference-dimensions ,sliced-expression) 
57
                            ',bindings)
58
           `(spocq.e:extend (spocq.e::with-reference-dimensions ,reference-dimensions ,field-expression)
59
                            ',bindings ,@args)))))
60
 ;;; (macroexpand '(spocq.a:|extend| (spocq.a:|bgp| (spocq.a:|triple| ?::s ?::p ?::o)) ?::x (+ ?::x 2)))
61
 
62
 (defun compact-extend (expression predicate)
63
   (if (extend-form-p expression)
64
       (destructuring-bind (operator field variable value) expression
65
         (multiple-value-bind (new-field variables values)
66
                              (compact-extend field predicate)
67
           (cond ((funcall predicate value)
68
                  (values new-field (append (list variable) variables) (append (list value) values)))
69
                 (t
70
                  (values `(,operator ,new-field ,variable ,value) variables values)))))
71
       expression))
72
 
73
 #+(or)
74
 (compact-extend
75
  '(ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
76
      (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
77
        (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple| ?::|s|
78
                                              |http://www.w3.org/2000/01/rdf-schema#|:|label|
79
                                              ?::|o|))
80
      ?::|version| (|http://dydra.com/sparql-functions#|:|version| ?::|s|))
81
  #'temporal-value-p)
82
 #+(or)
83
 (compact-extend
84
  '(ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
85
    (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
86
     (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
87
      (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
88
        (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple| ?::|s|
89
                                              |http://www.w3.org/2000/01/rdf-schema#|:|label|
90
                                              ?::|o|))
91
      ?::|version| (|http://dydra.com/sparql-functions#|:|version| ?::|s|))
92
     ?::|x| (+ 1 2))
93
    ?::|version3| (|http://dydra.com/sparql-functions#|:|version| ?::|s|))
94
  #'temporal-value-p)
95
 #+(or)
96
 (compact-extend
97
  '(ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
98
    (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
99
     (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|extend|
100
      (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
101
        (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple| ?::|s|
102
                                              |http://www.w3.org/2000/01/rdf-schema#|:|label|
103
                                              ?::|o|))
104
      ?::|version| (|http://dydra.com/sparql-functions#|:|version| ?::|s|))
105
     ?::|version2| (|http://dydra.com/sparql-functions#|:|version| ?::|s|))
106
    ?::|version3| (|http://dydra.com/sparql-functions#|:|version| ?::|s|))
107
  #'temporal-value-p)
108
 
109
 #+(or)
110
 (compact-extend
111
  '(ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
112
        (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple| ?::|s|
113
                                              |http://www.w3.org/2000/01/rdf-schema#|:|label|
114
                                              ?::|o|))
115
  #'temporal-value-p)
116
 
117
         
118
 (defgeneric spocq.e:extend (solution-field bindings &rest args &key end start)
119
   (:documentation "Given a solution field, a variable, and an evaluation function, compute a value for the
120
  variable. If the evaluation completes, augment each solution in the field with the
121
  binding. see:
122
   http://www.w3.org/2009/sparql/docs/query-1.1/rq25.xml#defn_extend")
123
 
124
   (:method :before ((field t) (bindings t) &key start end)
125
     (assert-argument-types spocq.e:extend
126
       (start (or null (integer 0)))
127
       (end (or null (integer 0))))
128
     (incf-stat *algebra-operations*)
129
     (trace-algebra process-extend field bindings
130
                    :start start :end end))
131
 
132
   (:method ((solution-field solution-generator) bindings &rest args)
133
     (declare (dynamic-extent args))
134
     (apply #'extend-generator solution-field bindings args))
135
 
136
   (:method ((null-field null) bindings  &rest args)
137
     (declare (dynamic-extent args))
138
     (apply #'extend-generator (unit-table-generator) bindings args)))
139
     
140
 
141
 
142
 (defun extend-generator (field-generator bindings &rest args &key start end)
143
   (let* ((variables (mapcar #'first bindings))
144
          (base-dimensions (solution-generator-dimensions field-generator))
145
          (result-dimensions (union-dimensions base-dimensions variables))
146
          (result-channel (make-channel :name (list 'spocq.a:|extend| (task-id *query*))
147
                                        :dimensions result-dimensions
148
                                        :size (effective-channel-size :start start :end end)
149
                                        :page-length (effective-page-length :start start :end end))))
150
     (when *strict-extend-bindings*
151
       ;; See [http://www.w3.org/TR/sparql11-query/#sparqlGrammar] wrt restrictions.
152
       (let ((already-bound (intersection variables base-dimensions)))
153
         (when already-bound
154
           (spocq.e:redefined-variable-error :variables already-bound
155
                                             :expression base-dimensions))))
156
     (labels ((run-extend-thread (result-channel field-generator bindings args)
157
                (let* ((base-dimensions (solution-generator-dimensions field-generator))
158
                       (base-channel (solution-generator-channel field-generator))
159
                       (expression (solution-generator-expression field-generator))
160
                       (*thread-operations* (cons (list* 'spocq.a:|extend| (task-id *task*)
161
                                                         base-dimensions result-dimensions
162
                                                         args)
163
                                                  *thread-operations*)))
164
                  (push 'spocq.a:|extend| (channel-name base-channel))
165
                  (query-run-in-thread *query* expression)
166
                  (setf (channel-size result-channel) (min (channel-size base-channel)
167
                                                           (channel-size result-channel))
168
                        (channel-page-length result-channel) (min (channel-page-length base-channel)
169
                                                                  (channel-page-length result-channel)))
170
                  (apply #'process-extend result-channel base-channel
171
                         result-dimensions base-dimensions
172
                         bindings
173
                         args)
174
                  'spocq.a:|extend|)))
175
       ;; return the binding function to the combination operator
176
       (make-solution-generator :operator 'spocq.a:|extend|
177
                                :dimensions result-dimensions
178
                                :expression (list #'run-extend-thread result-channel field-generator bindings
179
                                                  args)
180
                                :channel result-channel
181
                                :constituents (list field-generator)))))
182
 
183
 
184
 (defmethod process-extend ((destination array-page-channel)
185
                            (base-source array-page-channel)
186
                            result-dimensions base-dimensions bindings
187
                            &key start end)
188
   "Generate a stream of extended solutions to a continuation given a solution source and bindings list for
189
  additions to the source field. Invoke the source function repeatedly to obtain a stream of
190
  solution pages until the page is null. Arrange to evaluate each value expression in the context of the
191
  successive solutions to augment it and pass it on to the destination continuation."
192
 
193
   (declare (list result-dimensions base-dimensions bindings))
194
   (assert-argument-types process-extend
195
     (result-dimensions list)
196
     (base-dimensions list)
197
     (bindings list))
198
   (unless start (setf start 0))
199
   (when end (setf end (max start end)))
200
 
201
   (let ((collector (compute-extend-collector result-dimensions base-dimensions bindings)))
202
     (declare (type (function (array fixnum array fixnum) t) collector))
203
     (let* ((result-page-width (channel-page-width destination))
204
            (result-page-length (channel-page-length destination))
205
            (result-page nil)
206
            (result-index result-page-length)
207
            (result-count 0)
208
            (solution-count 0))
209
       (assert (= (length result-dimensions) result-page-width) ()
210
               "Channel and operation dimensions do not match: ~a: ~a." destination result-dimensions)
211
       (labels ((base-processor (base-page)
212
                  (dotimes (base-index (array-dimension base-page 0))
213
                    (collect-solution base-page base-index)))
214
                (collect-solution (base-page base-index)
215
                  (when (> (incf result-count) start)
216
                    (next-solution-location)
217
                    (funcall collector result-page result-index base-page base-index)
218
                    (when (and end (>= result-count end)) (complete-solutions))))
219
                (next-solution-location ()
220
                  ;; return a page (possible newly created) and the next free location in that page
221
                  (when (>= (incf result-index) result-page-length)
222
                    (when result-page (put-page result-page))
223
                    (setf result-page (new-field-page destination result-page-length result-page-width)
224
                          result-index 0)))
225
                (complete-solutions ()
226
                  (when result-page
227
                    (let ((page-result-count (1+ result-index)))
228
                      (when (< page-result-count result-page-length)
229
                        (setf result-page
230
                              (adjust-page result-page (list page-result-count result-page-width)))))
231
                    (put-page result-page))
232
                  (incf-stat *solutions-processed* solution-count)
233
                  (incf-stat *solutions-constructed* result-count)
234
                  (put-page nil)
235
                  (return-from process-extend (values solution-count result-count)))
236
              (put-page (page)
237
                (trace-data process-extend destination result-dimensions (term-value-field page))
238
                (if page
239
                  (put-field-page destination page)
240
                  (complete-field destination))))
241
         (unless (and (plusp result-page-length) (or (null end) (> end start))) (complete-solutions))
242
         (rlmdb:with-string-database (db)
243
           (do-pages (solutions base-source)
244
                     (check-query-status *query*)
245
                     (incf solution-count (array-dimension solutions 0))
246
                     (base-processor solutions)))
247
         (complete-solutions)))))