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

KindCoveredAll%
expression219249 88.0
branch1522 68.2
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 project 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
  (:long-description
11
   "project operates on the solution field to produce a result table as directed by the variable list.
12
  "))
13
 
14
 
15
 (defmacro spocq.a:|project| (solution-field result-dimensions &rest args &key count end offset start)
16
   "( ( solutionField ) solutionField )
17
 A PROJECT form produces a new solution field in which each solution comprises just the specified elements.
18
 Each element can be either a variable, or a (variable expression) binding.
19
 In the first case, any supplied argument value is included in the result solution.
20
 In the second, the respective expression for is evaluated for each solution to produce the respective
21
 result. If the variable is not bound in the original solution, no value appears in the result."
22
 
23
   (declare (ignore count end offset start))
24
   (apply #'macroexpand-project solution-field result-dimensions args))
25
 
26
 
27
 (defun macroexpand-project (solution-field bindings &rest args)
28
   (setf args (apply #'canonicalize-algebra-arguments args))
29
   (setf bindings (remove-duplicates bindings :test #'equal :from-end t))
30
   (if (and (bgp-form-p solution-field)
31
            (null args)
32
            (every #'variable-p bindings)
33
            (let ((bgp-dimensions (bgp-projected-dimensions (rest solution-field))))
34
              ;; require that the order agree
35
              (equal bindings bgp-dimensions)))
36
     solution-field
37
     (let ((reference-dimensions (bindings-value-variables bindings)))
38
       `(spocq.e:project (spocq.e::with-reference-dimensions ,reference-dimensions ,solution-field)
39
                         ',bindings
40
                         ,@args))))
41
 
42
 
43
 
44
 (defgeneric spocq.e:project (solution-field bindings &rest args &key end start)
45
   (:documentation "Given a solution field and a predicate, return a new field of those solutions
46
     which satisfy the predicate.")
47
 
48
   (:method :before ((solution-field t) (bindings t)&key end start)
49
     (assert-argument-types process-slice
50
       (start (or null (integer 0)))
51
       (end (or null (integer 0))))
52
     (incf-stat *algebra-operations*)
53
     (trace-algebra spocq.e:project solution-field bindings
54
                    :start start :end end))
55
 
56
   (:method ((solution-field solution-generator) bindings &rest args)
57
     (declare (dynamic-extent args))
58
     (apply #'spocq.e:stream-project solution-field bindings args)))
59
 
60
 
61
 (defun spocq.e:stream-project (field-generator bindings &rest args &key end start)
62
   (let* ((base-dimensions (solution-generator-dimensions field-generator))
63
          (result-dimensions (bindings-variables bindings))
64
          (result-channel (make-channel :name (list 'spocq.a:|project| (task-id *query*))
65
                                        :dimensions result-dimensions
66
                                        :size (effective-channel-size :start start :end end)
67
                                        :page-length (effective-page-length :start start :end end))))
68
     (if (equal base-dimensions result-dimensions)
69
       (if args
70
         (apply #'spocq.e::stream-slice field-generator args)
71
         field-generator)
72
       (labels ((run-project-thread (result-channel field-generator args)
73
                  (let ((base-dimensions (solution-generator-dimensions field-generator))
74
                        (base-channel (solution-generator-channel field-generator))
75
                        (base-expression (solution-generator-expression field-generator))
76
                        (*thread-operations* (cons (list* 'spocq.a:|project| bindings base-dimensions
77
                                                          args)
78
                                                   *thread-operations*)))
79
                    (push 'spocq.a:|project| (channel-name base-channel))
80
                    (setf (channel-size result-channel) (min (channel-size base-channel)
81
                                                             (channel-size result-channel))
82
                          (channel-page-length result-channel) (min (channel-page-length base-channel)
83
                                                                    (channel-page-length result-channel)))
84
                    (query-run-in-thread *query* base-expression)
85
                        (apply #'process-project result-channel base-channel
86
                               bindings
87
                               base-dimensions
88
                               args)
89
                        'spocq.a:|project|)))
90
         ;; return the binding function to the combination operator
91
         (make-solution-generator :operator 'spocq.a:|project|
92
                                  :dimensions result-dimensions
93
                                  :expression (list #'run-project-thread result-channel field-generator args)
94
                                  :channel result-channel
95
                                  :constituents (list field-generator))))))
96
 
97
 
98
 (defmethod process-project ((destination array-page-channel)
99
                             (base-source array-page-channel)
100
                             result-bindings base-dimensions &key (start 0) end)
101
   (declare (type (or channel (function ((or array null)) t)) destination)
102
            (type (or channel (function () (or array null))) base-source)
103
            (list result-bindings base-dimensions))
104
   (assert-argument-types process-project
105
     (result-bindings list)
106
     (base-dimensions list))
107
 
108
   (multiple-value-bind (collector result-dimensions)
109
                        (compute-project-operators result-bindings base-dimensions)
110
     (let* ((result-page-width (channel-page-width destination))
111
            (result-page-length (channel-page-length destination))
112
            (result-page nil)
113
            (result-index result-page-length)
114
            (result-count 0)
115
            (solution-count 0))
116
       (assert (= (length result-dimensions) result-page-width) ()
117
               "Channel and operation dimensions do not match: ~a: ~a." destination result-dimensions)
118
       (labels ((base-processor (base-page)
119
                  (dotimes (base-index (array-dimension base-page 0))
120
                    (collect-solution base-page base-index)))
121
                (collect-solution (base-page base-index)
122
                  (when (> (incf result-count) start)
123
                    (next-solution-location)
124
                    (funcall collector result-page result-index base-page base-index)
125
                    (when (and end (>= result-count end)) (complete-solutions))))
126
                (next-solution-location ()
127
                  ;; return a page (possible newly created) and the next free location in that page
128
                  (when (>= (incf result-index) result-page-length)
129
                    (when result-page (put-page result-page))
130
                    (setf result-page (new-field-page destination result-page-length result-page-width)
131
                          result-index 0)))
132
                (complete-solutions ()
133
                  (when result-page
134
                    (let ((page-result-count (1+ result-index)))
135
                      (when (< page-result-count result-page-length)
136
                        (setf result-page
137
                              (adjust-page result-page (list page-result-count result-page-width)))))
138
                    (put-page result-page))
139
                  (put-page nil)
140
                  (incf-stat *solutions-processed* solution-count)
141
                  (incf-stat *solutions-constructed* result-count)
142
                  (return-from process-project
143
                    (values solution-count result-count)))
144
                (put-page (page)
145
                  (trace-data process-project.put destination result-dimensions page)
146
                  (if page
147
                    (put-field-page destination page)
148
                    (complete-field destination))))
149
         (unless (and (plusp result-page-length) (or (null end) (> end start))) (complete-solutions))
150
         (when (or (null end) (> end start))
151
           (do-pages (solutions base-source)
152
                     (check-query-status *query*)
153
                     (incf solution-count (array-dimension solutions 0))
154
                     (trace-data process-project.get base-source base-dimensions solutions)
155
                     ;; (print (list :project base-source solutions))
156
                     (base-processor solutions)))
157
         ;; (print (list :project-complete base-source))
158
         (complete-solutions)))))
159
 
160
 
161
 (defun compute-project-operators (result-bindings base-dimensions)
162
   (values (compute-project-collector result-bindings base-dimensions)
163
           (bindings-variables result-bindings)))
164
 
165
 
166
 #|
167
 (run-test-query "
168
 PREFIX : <http://example.org/ns#>
169
 
170
 SELECT  DISTINCT ?v
171
 WHERE { [] :num ?v }
172
 ORDER BY ?v
173
 OFFSET 2
174
 LIMIT 5
175
 
176
 " :repository-id (lookup-repository-id :repository-name "solution-seq-slice-5" :account-name "jhacker"))
177
 
178
 |#