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

KindCoveredAll%
expression088 0.0
branch02 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 distinct operation for matrix fields")
6
 
7
 ;;; (load (compile-file "/development/source/library/org/datagraph/spocq/src/algebra/matrix-operators/distinct.lisp"))
8
 
9
 (defmethod spocq.e:distinct ((source-field matrix-field) &rest arguments &key start end)
10
   "Generate a distinct field to a result given a source and slice (start, end) specifications."
11
   
12
   (declare (dynamic-extent arguments))
13
   (let* ((base-dimensions (matrix-field-dimensions source-field))
14
          (length (- (or end (field-length source-field)) (or start 0)))
15
          (%data (rdfcache:make-matrix length (field-width source-field)))
16
          (result-field (clone-matrix-field source-field :data %data))
17
          (operator (apply #'matrix-distinct-operator base-dimensions base-dimensions arguments)))
18
       (apply operator result-field source-field
19
              arguments)
20
       (values result-field
21
               (solution-field-length source-field)
22
               (solution-field-length result-field))))
23
 
24
 (defmethod process-distinct ((result-field matrix-page-channel)
25
                              (source-field matrix-page-channel)
26
                              result-dimensions
27
                              &rest arguments
28
                              &key (start 0) end)
29
   (declare (dynamic-extent arguments))
30
   (let* ((base-dimensions (matrix-field-dimensions source-field))
31
          (length (- (or end (field-length source-field)) (or start 0)))
32
          (%data (rdfcache:make-matrix length (field-width source-field)))
33
          (result-field (clone-matrix-field source-field :data %data))
34
          (operator (apply #'matrix-distinct-operator base-dimensions base-dimensions arguments)))
35
       (apply operator result-field source-field
36
              arguments)
37
       (values (solution-field-length source-field)
38
               (solution-field-length result-field))))
39
                              
40
 
41
 (defun matrix-distinct-operator (result-dimensions source-dimensions &rest args)
42
   (declare (dynamic-extent args))
43
   (let ((projection (loop for source-dimension in source-dimensions
44
                           collect (position source-dimension result-dimensions))))
45
     (values (ensure-matrix-operator 'distinct :projection projection :slice (not (null args)))
46
             result-dimensions)))
47
 
48
     
49
 (defmethod compute-matrix-operator-lambda ((operator (eql 'distinct)) &key projection (slice nil))
50
   (let* ((source-column-count (length projection))
51
          (result-column-count (length (remove nil projection))))
52
     `(lambda (result-field source-field ,@(when slice '(&key (start 0) end)))
53
        ,(format nil "distinct operator for projection: ~s." projection)
54
        (declare (type matrix-field result-field source-field)
55
                 (optimize ,@*field-optimization*)
56
                 ,@(when slice '((type fixnum start))))
57
 
58
        (unless (= (length (solution-field-dimensions result-field)) ,result-column-count) ()
59
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
60
        (unless (= (length (solution-field-dimensions source-field)) ,source-column-count) ()
61
                (matrix-dimension-error :matrix source-field :expected-dimensions '(* ,source-column-count)))
62
        (incf-stat *algebra-operations*)
63
 
64
        (let ((%source-data (cffi::null-pointer))
65
              (%result-data (cffi::null-pointer))
66
              (source-row 0)
67
              (result-row 0))
68
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,source-column-count)) %source-data)
69
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
70
                   (type sb-sys:system-area-pointer %source-data %result-data)
71
                   (type fixnum source-row result-row)
72
                   )
73
          (let* ((%cache (rdfcache:make-matrix 1 ,result-column-count))
74
                 (%cache-data (rdfcache:matrix-data-pointer %cache)))
75
            (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %cache-data))
76
            (unwind-protect
77
              (progn (loop for i below ,result-column-count
78
                           do (setf (foreign-array-ref %cache-data 0 i) -1))
79
                     (setf (values %source-data source-row) (first-field-row source-field))
80
                     (loop ,@(when slice '(with result-count fixnum = 0 until (and end (>= result-count (the fixnum end)))))
81
                           until (cffi:null-pointer-p (setf (values %source-data source-row) (next-field-row source-field)))
82
                           do (progn (trace-matrix "~&distinct.next ~@{~a ~}" :source-row source-row :result-row result-row
83
                                                   :cache %cache-data (rdfcache::matrix-row-to-list %cache 0)
84
                                                   :source %source-data (rdfcache:matrix-data-pointer (matrix-field-solutions source-field))
85
                                                   (rdfcache::matrix-row-to-list (matrix-field-solutions source-field) source-row))
86
                                     (unless (zerop (compare-foreign-cache %cache-data (%source-data source-row) ',projection))
87
                                       ;; cache the new solution and emit it as a result subject to slice constraints
88
                                       (project-foreign-solution (%cache-data 0) (%source-data source-row) ',projection)
89
                                       (,@(if slice
90
                                            '(when (> (incf result-count) start))
91
                                            '(progn))
92
                                        (setf (values %result-data result-row) (new-field-row result-field))
93
                                        (trace-matrix "~&distinct.next-result ~@{~a ~}" :source-row source-row :result-row result-row
94
                                                      ,@(when slice '(:result-count result-count)))
95
                                        (project-foreign-solution (%result-data result-row) (%source-data source-row) ',projection)))
96
                                     )
97
                           ,@(when slice '(finally (trace-matrix "~&distinct.complete ~@{~a ~}" :result-row result-row :result-count result-count
98
                                                                 :start start :end end)))))
99
              (complete-field result-field)
100
              (rdfcache:matrix-release %cache)))
101
          result-field))))
102
 
103
 ;;; (spocq-compile (compute-matrix-operator-lambda 'distinct :projection '(1 nil 3 2)))
104
 ;;; (spocq-compile (compute-matrix-operator-lambda 'distinct :projection '(1 nil 3 2) :slice t))