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

KindCoveredAll%
expression0109 0.0
branch08 0.0
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 "sparql construct operation for matrix fields"
6
 
7
  (copyright
8
   "Copyright 2013 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
9
 
10
  (:long-description
11
   "The construct query form uses the result of the base query to generates a statement graph (an s-p-o field)
12
  for each solution set.
13
  nb. the solution modifiers must be handled outside as a slice on the argument solution field.
14
  "))
15
 
16
 
17
 (defmethod spocq.e:construct ((source-field matrix-field) graph-pattern)
18
   (let ((operator (matrix-construct-operator (solution-field-dimensions source-field) graph-pattern))
19
         (result-field (make-matrix-field :dimensions *construct-dimensions* :sort-dimensions nil)))
20
     (funcall operator result-field source-field)
21
     (release-field-data source-field)
22
     (values result-field
23
             (solution-field-length source-field)
24
             (solution-field-length result-field))))
25
 
26
 (defmethod process-construct ((result-field matrix-page-channel)
27
                               (source-field matrix-page-channel)
28
                               base-dimensions graph-pattern)
29
   (declare (type list base-dimensions graph-pattern))
30
   (assert-argument-types process-construct
31
     (base-dimensions list)
32
     (graph-pattern list))
33
   (let ((operator (matrix-construct-operator (solution-field-dimensions source-field) graph-pattern))
34
           (result-field (make-matrix-field :dimensions *construct-dimensions* :sort-dimensions nil)))
35
       (funcall operator result-field source-field)
36
       (release-field-data source-field)
37
       (values (solution-field-length source-field)
38
               (solution-field-length result-field))))
39
 
40
 
41
 
42
 (defun matrix-construct-operator (source-dimensions graph-pattern)
43
   (let* ((interned-pattern ())
44
          (blank-node-list ())
45
          (variable-map ()))
46
     (labels ((intern-pattern-term (term)
47
                (cond ((undistinguished-variable-p term)
48
                       ;; treat it as if it were a blank node to the replaced for each solution
49
                       (or (getf variable-map term)
50
                           (setf (getf variable-map term) (cons-blank-node ))))
51
                      ((variable-p term)
52
                       (let ((position (position term source-dimensions)))
53
                         (cond (position
54
                                (list position))
55
                               ((boundp term)    ;;;;!!! must change if dynamic bindings are not implemented with progv
56
                                (symbol-value term))
57
                               (t ;; treat undefined variable as error, or warn
58
                                (case (undefined-variable-behavior)
59
                                  (|urn:dydra|:|error|
60
                                   (spocq.e:compilation-error :expression graph-pattern
61
                                                              :condition (make-condition 'spocq.e:undefined-variable-error
62
                                                                                         :variables (list term))))
63
                                  (|urn:dydra|:|warning|
64
                                   (log-warn "~@[~a: ~]~a"
65
                                             *query*
66
                                             (make-condition 'spocq.e:undefined-variable-error :variables (list term)))
67
                                   (spocq:make-unbound-variable term))
68
                                  (|urn:dydra|:|ignore|
69
                                   +null-term-id+))))))
70
                      ((spocq:blank-node-p term)
71
                       (let ((old (find term blank-node-list :test #'equalp)))
72
                         (if old
73
                           (setf term old)
74
                           (push term blank-node-list))
75
                         term))
76
                      (t
77
                       (object-term-number term)))))
78
       (setf interned-pattern (loop for statement in graph-pattern
79
                                    collect (mapcar #'intern-pattern-term (statement-terms statement))))
80
       (ensure-matrix-operator 'construct :source-column-count (length source-dimensions)
81
                               :graph-pattern interned-pattern))))
82
 
83
 (defmethod compute-matrix-operator-lambda ((operator (eql 'construct)) &key
84
                                            source-column-count
85
                                            graph-pattern)
86
   `(lambda (result-field source-field &key (start 0) (end nil))
87
      (declare (type matrix-field result-field source-field)
88
               (optimize ,@*field-optimization*)
89
               (type fixnum start)
90
               )
91
 
92
      (let ((blank-node-map ())
93
            (result-cache (make-solution-cache :single-thread t))
94
            (interned-pattern ',graph-pattern))
95
        (flet ((update-blank-nodes ()
96
                 (loop for node-pair in blank-node-map
97
                       do (setf (rest node-pair) (rdfcache-object-term-number *transaction* (cons-blank-node)))))
98
               (get-blank-node-term-number (node)
99
                 (or (rest (assoc node blank-node-map))
100
                     (let ((pair (cons node (rdfcache-object-term-number *transaction* (cons-blank-node)))))
101
                       (push pair blank-node-map)
102
                       (rest pair)))))
103
       ;; then reiterate it for each solution
104
          (let ((%source-data (cffi:null-pointer))
105
                (%result-data (cffi:null-pointer))
106
                (source-row 0)
107
                (result-row 0))
108
            (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,source-column-count)) %source-data)
109
                     (foreign-type (foreign-array ,+matrix-element-type+ (* 3)) %result-data)
110
                     (type sb-sys:system-area-pointer %source-data %result-data)
111
                     (type fixnum source-row result-row))
112
            (setf (values %source-data source-row) (first-field-row source-field))
113
            (loop with result-count = 0
114
                  until (and end (>= result-count (the fixnum end)))
115
                  until (cffi:null-pointer-p %source-data)
116
                  when (> (incf result-count) start)
117
                  do (flet ((result-term (pattern-term)
118
                              (etypecase pattern-term
119
                                (cons (foreign-array-ref %source-data source-row (first pattern-term)))
120
                                (integer pattern-term)
121
                                (spocq:blank-node (get-blank-node-term-number pattern-term))
122
                                (spocq:unbound-variable +null-term-id+))))
123
                       (update-blank-nodes)
124
                       (loop for (ps pp po) in interned-pattern
125
                             for s = (result-term ps)
126
                             for p = (result-term pp)
127
                             for o = (result-term po)
128
                             ;; suppress statements with unbound terms
129
                             ;; do (print (list (list ps pp po) (list s p o)))
130
                             unless (or (= s +null-term-id+)
131
                                        (= p +null-term-id+)
132
                                        (= o +null-term-id+))
133
                             do (let ((key (list s p o)))
134
                                  (declare (dynamic-extent key))
135
                                  ;; suppress duplicates
136
                                  (cond ((gethash key result-cache))
137
                                        (t
138
                                         (setf (gethash (copy-list key) result-cache) t)
139
                                         (setf (values %result-data result-row) (new-field-row result-field))
140
                                         (setf (foreign-array-ref %result-data result-row 0) s
141
                                               (foreign-array-ref %result-data result-row 1) p
142
                                               (foreign-array-ref %result-data result-row 2) o)))))
143
                       (setf (values %source-data source-row) (next-field-row source-field))))))
144
        result-field)))
145
 
146
 ;;; (compile nil (compute-matrix-operator-lambda 'construct :source-column-count 4 :graph-pattern '(((0) 2 <_:tmp>))))