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

KindCoveredAll%
expression0174 0.0
branch022 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 "This file defines the jena/ARQ extension operators for the 'org.datagraph.spocq' RDF engine."
6
 
7
  (copyright
8
   "Copyright 2011 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
9
 
10
  (long-description
11
   "The file defines the ARQ extension operators for SPOCQ. The initial complement comprises
12
 
13
   - list:member
14
 
15
   The interface convention is that the standard interface operator is a native function which takes two
16
  arguments, the term model instances for subject and object, and returns a single model instance as its
17
  result. This linkage is intended  for a filter clause, an aggregation expression, or a binding.
18
  The respective context operator is compiled to handle the term-number <-> object mapping in the operator
19
  call.
20
  For example, for the list:member
21
  these would be a uri or a blank node and a term instance or a wildcard (nil) and the result would either
22
  be a boolean or the list of instances
23
 
24
  ---
25
  [1]:http://jena.sourceforge.net/ARQ/library-propfunc.html
26
  "))
27
 
28
 (defmethod extension-operator-p ((object (eql '|http://jena.hpl.hp.com/ARQ/list#|:|member|)))
29
   ;; even though it is a macro
30
   t)
31
 
32
 (defmacro |arq|:|member| (list element &optional graph &environment env)
33
   ;; the argument expressions are symbol macros if in the context of a field interation
34
   (let ((list-expansion (macroexpand-1 list env))
35
         (element-expansion (macroexpand-1 element env))
36
         (graph-expansion (macroexpand-1 graph env)))
37
     (if (and (field-object-aref-p list-expansion) (field-object-aref-p element)
38
              (field-object-aref-p graph-expansion))
39
       `(term-number-object (arq.i::member (aref ,@(field-object-aref-aref list-expansion))
40
                                           (aref ,@(field-object-aref-aref element-expansion))
41
                                           (aref ,@(field-object-aref-aref graph-expansion))))
42
       `(arq.e::member ,list ,element ,graph))))
43
 
44
 
45
 (defun arq.e:member (list element &optional (graph nil))
46
   (if (and list element)
47
     (repository-term-number-object *transaction*
48
                                    (arq.i::member (object-term-number list)
49
                                                   (object-term-number element)
50
                                                   (case graph
51
                                                     ((nil t) rlmdb:*default-context-number*)
52
                                                     (t (object-term-number graph)))))
53
     spocq.a:|false|))
54
 
55
 (defun arq.i::member (list-term element-term &optional (graph-term rlmdb:*default-context-number*))
56
   (case graph-term
57
     ((nil t) (setf graph-term rlmdb:*default-context-number*)))
58
   (cond ((and list-term element-term)
59
          (repository-map-list #'(lambda (list-element-term)
60
                                 (when (= list-element-term element-term)
61
                                   (return-from arq.i:member (spocq:term-id spocq.a:|true|))))
62
                             *transaction* graph-term list-term))
63
         (list-term
64
          (let ((result ()))
65
            (repository-map-list #'(lambda (list-element-term)
66
                                   (push list-element-term result))
67
                               *transaction* graph-term list-term)
68
            (mapcar #'intern-term result))
69
          (spocq:term-id spocq.a:|false|))
70
         (t
71
          (spocq:term-id spocq.a:|false|))))
72
 
73
 
74
   
75
 (defmethod funcall-extension (repository-handle context list (property (eql '|arq|:|member|)) member continuation)
76
   "Membership of an RDF List (RDF Collection).
77
    If list is not bound or a constant, find and iterate all lists in the graph (can be slow) else evaluate for one particular list.
78
    If member a variable, generate solutions with member bound to each element in the list.
79
    If member is bound or a constant expression, test to see if a member of the list.
80
    (see https://jena.apache.org/documentation/query/library-propfunc.html)
81
 
82
    If the list is a term, use that to constrain the member generation or test
83
    If the object is also  a term, test it against the generated set(s).
84
    For membership and return the result as a boolean.
85
    If, on the other hand, the member is a wild-card, invoke the continuation on the s-p across the generated member terms
86
  
87
    The wildcard list options are implemented for lmdb transactions only."
88
 
89
   ; (declare (dynamic-extent continuation))
90
   (let ((count 0))
91
     (flet ((operate-on-list (list)
92
              (flet ((test-member (list-member)
93
                       (when (zerop (rlmdb:term-compare member list-member))
94
                         (return-from funcall-extension spocq.a:|true|))
95
                       (incf count))
96
                     (generate-members (list-member)
97
                       (funcall continuation context list property list-member)
98
                       (incf count)))
99
                (declare (dynamic-extent #'test-member #'generate-members))
100
                (if (typep member '(integer 1))
101
                    (repository-map-list #'test-member repository-handle context list)
102
                    (repository-map-list #'generate-members repository-handle context list)))))
103
       (if (typep list '(integer 1))
104
           (operate-on-list list)
105
           (map-repository-subjects #'operate-on-list repository-handle :context context))
106
       (if (typep member '(integer 1))
107
           spocq.a:|false|
108
           count))))
109
 
110
 
111
 (defgeneric repository-map-list (continuation transaction context root-term)
112
   (:documentation
113
    "Given an operator and a store transaction/context, apply the operator in turn to each
114
    successive rdf:first object.
115
    Start from the root term, which must be a term or term number, and walk the list.
116
    Allow that multiple first/rest links are present from a given root term.
117
    Maintain a visited cache in order to break circular paths.")
118
   (:method ((continuation t) (repository lmdb-repository) context root-term)
119
     (repository-map-list continuation (repository-lmdb-repository repository) context root-term))
120
 
121
   (:method :around ((continuation t) (repository rlmdb:repository) context root-term)
122
     (cond ((and lmdb:*transaction*
123
                 (eq (lmdb:transaction-environment lmdb:*transaction*) repository))
124
            (call-next-method))
125
           (t
126
            (lmdb:with-transaction ((transaction  (lmdb:make-transaction repository :flags liblmdb:+rdonly+))
127
                                    :initial-disposition :begin :normal-disposition :abort
128
                                    :error-disposition :abort)
129
              (call-next-method)))))
130
 
131
   (:method ((continuation t) (repository rlmdb:repository) context root-term)
132
     "Perform the iteration with a single cursor and a depth-first stack of rest (combination) nodes.
133
      For each combination, first iterate over the related rdf:first objects and apply the function to each
134
      Next iterate likewise the rdf:rest object, but just add them to the deferred collection.
135
      Then pop a node off the deferred collection and continue the process with it as root.
136
      Return once the deferred collection is exhausted."
137
 
138
     (let ((root-term-list root-term)
139
           (rest-cache (make-hash-table :test 'eql))
140
           (count 0))
141
       (setf (gethash root-term rest-cache) root-term)
142
       (flet ((emit-member (%quad)
143
                (funcall continuation (%quad-object %quad))
144
                (incf count))
145
              (collect-rest-terms (%quad)
146
                (let ((rest-term (%quad-object %quad)))
147
                  (unless (gethash rest-term rest-cache)
148
                    (setf (gethash rest-term rest-cache) rest-term)
149
                    (push rest-term root-term-list)))
150
                t))
151
           (declare (dynamic-extent #'emit-member  #'collect-rest-terms))
152
           (loop (unless root-term-list (return count))
153
                 (let ((next-root-term (pop root-term-list)))
154
                   (rlmdb:map-repository-statements #'emit-member repository (vector context next-root-term (symbol-term-id '|rdf|:|first|) 0))
155
                   (rlmdb:map-repository-statements #'collect-rest-terms repository (vector context next-root-term (symbol-term-id '|rdf|:|rest|) 0))))))))
156
 
157
 #|
158
 ;; testing against heltnormalt
159
 
160
 (defun test-map-list (graph root &key (repository "239/1071"))
161
   (let* ((graph-term (or (object-term-number graph)
162
                          (error "no interned term: ~s" graph)))
163
          (root-term (or (object-term-number root)
164
                         (error "no interned term: ~s" root)))
165
          (query (make-test-query :repository-id repository
166
                                  :id  "test"
167
                                  :sse-expression ())))
168
     (with-task-environment (:task query)
169
       (spocq.e::map-list #'(lambda (term-number) (print (term-number-object term-number)))
170
                          *transaction*
171
                          graph-term
172
                          root-term))))
173
 
174
 (test-map-list <http://local.heltnormalt.dk/graphs/4eb555f42bb3b> <_:b161>)
175
 (test-map-list <http://data.totl.net/zodiac/ontology/> <_:b103>)
176
 
177
 (parse-sparql "
178
 PREFIX dct: <http://purl.org/dc/terms/>
179
 PREFIX foaf: <http://xmlns.com/foaf/0.1/>
180
 PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
181
 PREFIX hn: <http://semantic-web.dk/ontologies/heltnormalt#>
182
 PREFIX list: <http://jena.hpl.hp.com/ARQ/list#>
183
 SELECT * WHERE {
184
         GRAPH ?postGraph
185
         {
186
             ?post foaf:isPrimaryTopicOf ?admin .
187
             ?admin rdf:type hn:AdminHoroscopeResource .
188
             ?post dct:hasPart ?list .
189
             ?list list:member ?subPost .
190
         }
191
  }
192
 ")
193
 
194
 (run-test-query "
195
 PREFIX dct: <http://purl.org/dc/terms/>
196
 PREFIX foaf: <http://xmlns.com/foaf/0.1/>
197
 PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
198
 PREFIX hn: <http://semantic-web.dk/ontologies/heltnormalt#>
199
 PREFIX list: <http://jena.hpl.hp.com/ARQ/list#>
200
 SELECT * WHERE {
201
         GRAPH ?postGraph
202
         {
203
             ?post foaf:isPrimaryTopicOf ?admin .
204
              ?post dct:hasPart ?list .
205
              ?list list:member ?subPost .
206
         }
207
  } limit 10
208
 " :repository-id "239/1071")
209
 
210
 (run-test-query "
211
 PREFIX sioc: <http://rdfs.org/sioc/ns#>
212
 
213
 select * where { # count (*) where {
214
  graph <http://local.heltnormalt.dk/graphs/4eb555f42bb3b> { _:b161 ?p ?o
215
  }
216
 } order by (?p)
217
 " :repository-id "6/1245")
218
 
219
                        
220
 |#