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

KindCoveredAll%
expression0232 0.0
branch028 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; first: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 (defmethod spocq.e:union ((base-field matrix-field) (added-field matrix-field) &key start end)
6
   "Combine two source fields to produce solutions to a continuation.
7
  If they are same dimension, then just append the second to the base.
8
  Otherwise create a result to accept the merged dimensions and concatenate them.
9
  If a slice (start,end) is present, alwazs merge in order to apply the constraints to limit the result.
10
 
11
  nb. this must allow unequal constituent dimensins by extending the result domain as required.
12
  in order for that result to be useful, the dominant operators cannot be a join/leftjoin
13
  as the constant field domain would cause any unbound variables to miss solutions."
14
 
15
   (let ((base-dimensions (solution-field-dimensions base-field))
16
         (added-dimensions (solution-field-dimensions added-field)))
17
     (cond ((and (equal base-dimensions added-dimensions) (null start) (null end))
18
            (let ((result-field (solution-field-concatenate base-field added-field)))
19
              (complete-field-input base-field)
20
              (complete-field-input added-field)
21
              (complete-field-output result-field)
22
              (values result-field
23
                      (+ (solution-field-length base-field) (solution-field-length added-field))
24
                      (solution-field-length result-field))))
25
           (t
26
            (unless start (setf start 0))
27
            (let* ((base-length (field-length base-field))
28
                   (added-length (field-length added-field))
29
                   (length (- (or end (+ base-length added-length)) (or start 0)))
30
                   (result-dimensions (union-dimensions base-dimensions added-dimensions))
31
                   (width (length result-dimensions))
32
                   (%data (rdfcache:make-matrix length width))
33
                   (result-field (clone-matrix-field base-field :data %data
34
                                                     :dimensions result-dimensions
35
                                                     :sort-dimensions ())))
36
              (let ((%source-data (cffi:null-pointer))
37
                    (source-row 0)
38
                    (%result-data (cffi:null-pointer))
39
                    (result-row 0)
40
                    (result-count 0))
41
                (declare (type sb-sys:system-area-pointer %source-data %result-data)
42
                         (type fixnum source-row result-row start))
43
                (when (and (< start base-length) (or (null end) (> end 0)))
44
                  (let ((collector (matrix-project-solution-operator result-dimensions base-dimensions)))
45
                    (loop while (or (null end) (< result-count end))
46
                          until (cffi:null-pointer-p (setf (values %source-data source-row) (next-field-row base-field)))
47
                          if (> (incf result-count) start)
48
                          do (progn (setf (values %result-data result-row) (new-field-row result-field))
49
                                    (funcall collector %result-data result-row %source-data source-row)))))
50
                (when (and (< start length) (or (null end) (>= end base-length)))
51
                  (let ((collector (matrix-project-solution-operator result-dimensions added-dimensions)))
52
                    (loop while (or (null end) (< result-count end))
53
                          until (cffi:null-pointer-p (setf (values %source-data source-row) (next-field-row added-field)))
54
                          if (> (incf result-count) start)
55
                          do (progn (setf (values %result-data result-row) (new-field-row result-field))
56
                                    (funcall collector %result-data result-row %source-data source-row)))))
57
                (complete-field-output result-field)
58
                (complete-field-input base-field)
59
                (complete-field-input added-field)
60
                (values result-field
61
                      (+ base-length added-length)
62
                      (solution-field-length result-field))))))))
63
 
64
 (defmethod process-union ((result-field matrix-page-channel)
65
                           (base-field matrix-page-channel)
66
                           (added-field matrix-page-channel)
67
                           result-dimensions base-dimensions added-dimensions
68
                           &key (start 0) (end nil))
69
   (let ((operator (matrix-union-operator result-dimensions base-dimensions added-dimensions :start start :end end)))
70
     (funcall operator result-field base-field added-field  :start start :end end)
71
     (values (channel-solution-count result-field)
72
             (+ (channel-solution-count base-field) (channel-solution-count added-field)))))
73
 
74
 
75
 (defun matrix-project-solution-operator (result-column-count projection)
76
   (ensure-matrix-operator 'project-solution :result-column-count result-column-count :projection projection))
77
 
78
 (defmethod compute-matrix-operator-lambda ((operator (eql 'project-solution)) &key projection result-column-count)
79
   (let* ((source-column-count (length projection)))
80
   `(lambda (%result-data result-row %source-data source-row)
81
      (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,source-column-count)) %source-data)
82
               (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
83
               (type sb-sys:system-area-pointer %source-data %result-data)
84
               (type fixnum source-row result-row)
85
               )
86
      (project-foreign-solution (%result-data result-row) (%source-data source-row) ',projection))))
87
 
88
 (defun matrix-union-operator (result-dimensions base-dimensions added-dimensions &key start end)
89
   (let ((base-projection (loop for variable in base-dimensions
90
                                collect (position variable result-dimensions)))
91
         (added-projection (loop for variable in added-dimensions
92
                                 collect (position variable result-dimensions)))
93
         (result-column-count (length result-dimensions)))
94
     (ensure-matrix-operator 'union
95
                             :result-column-count result-column-count
96
                             :base-projection base-projection :added-projection added-projection
97
                             :slice (not (null (or start end))))))
98
 
99
 
100
 (defmethod compute-matrix-operator-lambda ((operator (eql 'union)) &key base-projection added-projection result-column-count slice)
101
   (let ((base-collector (matrix-project-solution-operator result-column-count base-projection))
102
         (added-collector (matrix-project-solution-operator result-column-count added-projection)))
103
     `(lambda (result-field base-field added-field ,@(when slice '(&key (start 0) end)))
104
        (declare (type sb-sys:system-area-pointer %source-data %result-data)
105
                 (type fixnum source-row result-row start))
106
        (when ,(if slice '(and (< start base-length) (or (null end) (> end 0))) t)
107
          (loop ,@(when slice '(while (or (null end) (< result-count end))))
108
                until (cffi:null-pointer-p (setf (values %source-data source-row) (next-field-row base-field)))
109
                ,@(when slice '(if (> (incf result-count) start)))
110
                do (progn (setf (values %result-data result-row) (new-field-row result-field))
111
                          (locally ,@(cddr base-collector)))))
112
        (when ,(if slice '(and (< start length) (or (null end) (>= end base-length))) t)
113
          (loop ,@(when slice '(while (or (null end) (< result-count end))))
114
                until (cffi:null-pointer-p (setf (values %source-data source-row) (next-field-row added-field)))
115
                ,@(when slice '(if (> (incf result-count) start)))
116
                do (progn (setf (values %result-data result-row) (new-field-row result-field))
117
                          (locally ,@(cddr added-collector)))))
118
        (complete-field-output result-field)
119
        (complete-field-input base-field)
120
        (complete-field-omput added-field)
121
      result-field)))