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

KindCoveredAll%
expression0163 0.0
branch010 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 order operation for matrix fields")
6
 
7
 ;;; (load (compile-file "/development/source/library/org/datagraph/spocq/src/algebra/matrix-operators/order.lisp"))
8
 
9
 (defmethod spocq.e:order ((source-field matrix-field) order-predicate-form &rest arguments
10
                           &key (start 0) end)
11
     (declare (dynamic-extent arguments))
12
     
13
     (multiple-value-bind (sort-order key-operator predicate-operators)
14
                          (matrix-key-list-operator (solution-field-dimensions source-field) order-predicate-form)
15
       (if (equal (solution-field-sort-dimensions source-field) sort-order)
16
         (apply #'spocq.e:slice source-field arguments)
17
         (let* ((length (- (or end (field-length source-field)) start))
18
                (%data (rdfcache:make-matrix length (field-width source-field)))
19
                (result-field (clone-matrix-field source-field :data %data)))
20
           (multiple-value-bind (operator result-dimensions)
21
                                (apply #'matrix-order-operator
22
                                       (or (result-field-dimensions result-field) (solution-field-dimensions source-field))
23
                                       (solution-field-dimensions source-field)
24
                                       arguments)
25
             (declare (ignore result-dimensions))
26
             (apply operator result-field source-field
27
                    predicate-operators
28
                    key-operator
29
                    arguments))
30
           (values result-field
31
                   (solution-field-length source-field)
32
                   (solution-field-length result-field))))))
33
 
34
 
35
 (defun matrix-order-operator (result-dimensions source-dimensions &rest args)
36
   (declare (dynamic-extent args))
37
   (let ((projection (loop for source-dimension in source-dimensions
38
                           collect (position source-dimension result-dimensions))))
39
     (values (ensure-matrix-operator 'order :projection projection :result-column-count (length result-dimensions) :slice (not (null args)))
40
             result-dimensions)))
41
 
42
 (defmethod compute-matrix-operator-lambda ((operator (eql 'order)) &key projection result-column-count (slice nil))
43
   (let* ((source-column-count (length projection)))
44
     `(lambda (result-field source-field predicate-operators key ,@(when slice '(&key (start 0) end)))
45
        ,(format nil "order operator for projection: ~s,~s." projection result-column-count)
46
        (declare (type matrix-field result-field source-field)
47
                 (optimize ,@*field-optimization*)
48
                 ,@(when slice '((type fixnum start))))
49
        
50
        (trace-algebra matrix-order :result-field result-field :source-field source-field 
51
                       ,@(when slice '(:start start :end end)))
52
        (unless (= (length (solution-field-dimensions result-field)) ,result-column-count) ()
53
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
54
        (unless (= (length (solution-field-dimensions source-field)) ,source-column-count) ()
55
                (matrix-dimension-error :matrix source-field :expected-dimensions '(* ,source-column-count)))
56
        (incf-stat *algebra-operations*)
57
 
58
        (multiple-value-bind (%source-data source-row-count)
59
                             (solution-field-materialize source-field)
60
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,source-column-count)) %source-data)
61
                   (type sb-sys:system-area-pointer %source-data)
62
                   (type fixnum source-row-count))
63
          (let ((%result-data (cffi::null-pointer))
64
                (result-row 0))
65
            (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
66
                     (type sb-sys:system-area-pointer %result-data)
67
                     (type fixnum result-row)
68
                     )
69
            (handler-bind ((error (lambda (c)
70
                                    (declare (ignore c))
71
                                    (throw :skip nil))))
72
              (flet ((predicate (entry-one entry-two)
73
                       ; (print (list :entry-one entry-one :entry-two entry-two :predicate-operators predicate-operators) *trace-output*) (finish-output *trace-output*)
74
                       (catch :skip
75
                         (loop for sub-key-one in (first entry-one)
76
                               for sub-key-two in (first entry-two)
77
                               for predicate in predicate-operators
78
                               unless (and sub-key-one sub-key-two)
79
                               return nil
80
                               if (funcall predicate sub-key-one sub-key-two)
81
                               return t
82
                               else unless (spocq.e:= sub-key-one sub-key-two)
83
                               return nil))))
84
                (declare (dynamic-extent #'predicate))
85
                (let ((keyed-indices (make-array source-row-count))
86
                      (null-key (funcall key (cffi:null-pointer) 0))
87
                      (*enable-sort-precedence* t))
88
                  (dotimes (source-row source-row-count)
89
                    (setf (svref keyed-indices source-row)
90
                          (cons (or (catch :skip
91
                                      (funcall key %source-data source-row))
92
                                    null-key)
93
                                source-row)))
94
                  ; (let ((*print-array* t)) (print keyed-indices))
95
                  (sort keyed-indices #'predicate)
96
                  (loop ,@(when slice `(with result-count fixnum = 0))
97
                        for (nil . source-row) across keyed-indices
98
                        ,@(when slice '(while (or (null end) (< result-count (the fixnum end)))))
99
                        do (,@(if slice
100
                                '(when (> (incf result-count) start))
101
                                '(progn))
102
                            (setf (values %result-data result-row) (new-field-row result-field))
103
                            (trace-matrix "~&sort.next-result ~@{~a ~}" :source-row source-row :result-row result-row
104
                                          ,@(when slice '(:result-count result-count)))
105
                            (project-foreign-solution (%result-data result-row) (%source-data source-row) ',projection))))))))
106
        result-field)))
107
 
108
 
109
 (defun matrix-key-list-operator (source-dimensions order-predicate-form)
110
   (values (loop with generated-id = 0
111
                 for order-specification in order-predicate-form
112
                 for order-expression = (if (consp order-specification)
113
                                          (case (first order-specification)
114
                                            ((spocq.a::|asc| spocq.a::|desc|) (second order-specification))
115
                                            (t order-specification))
116
                                          order-specification)
117
                 collect (if (variable-p order-expression)
118
                           order-expression
119
                           (cons-symbol *variable-package* (format nil "?~d" (incf generated-id)))))
120
           (spocq-compile (compute-matrix-operator-lambda 'key-list :source-dimensions source-dimensions
121
                                                          :order-predicate-form order-predicate-form))
122
           (compute-sort-predicate-operators order-predicate-form)))
123
 
124
 
125
 (defmethod compute-matrix-operator-lambda ((operator (eql 'key-list)) &key source-dimensions order-predicate-form)
126
   (let* ((source-column-count (length source-dimensions))
127
          (variables (expression-variables order-predicate-form))
128
          (key-forms (loop for order-expression in order-predicate-form
129
                           collect (if (consp order-expression)
130
                                     (case (first order-expression)
131
                                       ((spocq.a::|asc| spocq.a::|desc|) (second order-expression))
132
                                       (t order-expression))
133
                                     order-expression)))
134
          (key-column-count (length order-predicate-form))
135
          (undefined-variables ())
136
          (bindings (loop for variable in variables
137
                          for i = (position variable source-dimensions)
138
                          collect `(,variable ,(cond (i `(foreign-array-named-object-ref ,variable %source-data source-row ,i))
139
                                                     (t (push variable undefined-variables)
140
                                                        `(query-binding-value ',variable))))))
141
          (lambda `(lambda (%source-data source-row)
142
                     (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,source-column-count)) %source-data)
143
                              (type sb-sys:system-area-pointer %source-data)
144
                              (type fixnum source-row))
145
                     (if (cffi:null-pointer-p %source-data)
146
                       (make-list ,key-column-count :initial-element nil)
147
                       (let* ,bindings
148
                         (list ,@key-forms))))))
149
     (when undefined-variables
150
       (case (undefined-variable-behavior)
151
         (|urn:dydra|:|error| (spocq.e:compilation-error :expression order-predicate-form
152
                                                 :condition (make-condition 'spocq.e:undefined-variable-error
153
                                                                            :variables undefined-variables)))
154
         (|urn:dydra|:|warning| (log-warn "~@[~a: ~]~a"
155
                                          *query*
156
                                          (make-condition 'spocq.e:undefined-variable-error
157
                                                          :expression order-predicate-form
158
                                                          :variables undefined-variables))
159
                                (push `(declare (special ,@undefined-variables)) (cddr lambda)))
160
         (|urn:dydra|:|dynamicBinding| (push `(declare (special ,@undefined-variables)) (cddr lambda)))))
161
     lambda))
162
 
163
 
164