Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/ssf-sparql-1-0-5-formula.lisp

KindCoveredAll%
expression354778 45.5
branch3186 36.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.sparql-1-0-4; -*-
2
 
3
 (in-package :org.datagraph.spocq.sparql-1-0-4)
4
 
5
 ;;; to handle quad construct wrt 1.0.4 
6
 
7
 ;;; reduction operators
8
 
9
 (defun |Add-Constructor| (GraphOrDefaultx2 Silence?)
10
   `(spocq.a:|add| ,@(reverse GraphOrDefaultx2) ,@(unless Silence? `(:verbose t))))
11
 
12
 (defun |Annotation-Constructor| (VerbObjectList)
13
   VerbObjectList)
14
 
15
 (defun |ArithmeticAggregate-Constructor| (ArithmeticAggregateOperator Distinctness? Expression*)
16
   `(,ArithmeticAggregateOperator ,@(reverse Expression*)
17
                                  ,@(when Distinctness? `(:distinct ,Distinctness?))))
18
 
19
 (defun |AskQuery-Constructor| (DatasetClause* SolutionModifier WhereClause)
20
   "Combine any modifiers into the where clause and construct an ask on whatever combination results."
21
 
22
   (update-dataset-graphs DatasetClause* :query)
23
   (when SolutionModifier
24
     (destructuring-bind (&key limit offset order group-by) SolutionModifier
25
       (declare (ignore group-by)) ; group can hace no effect as there is no aggregation
26
       (when (and order (or limit offset))
27
         ;; order iff a slice is present
28
         (setf WhereClause `(spocq.a:|order| ,WhereClause ,order)))
29
       (when (or limit offset)
30
         (setf WhereClause `(spocq.a:|slice| ,WhereClause
31
                                             ,@(when offset `(:offset ,offset))
32
                                             ,@(when limit `(:count ,limit)))))))
33
   `(spocq.a:|ask| ,WhereClause))
34
 
35
 (defun |BaseDecl-Constructor| (IRI_REF)
36
   (setf (base-iri) IRI_REF))
37
 
38
 (defun |Bind-Constructor| (Expression IRIref Lambda Var)
39
   (cond ((and Expression Var)
40
          ;; return a tagged binding for later combination
41
          `(:bind ,Var ,Expression))
42
         (t
43
          (spocq.i::log-warn "Lambda is not enabled")
44
          IRIref Lambda
45
          '(spocq.a:|table| spocq.a:|unit|))))
46
 
47
 (defun |BuiltInCall-Constructor| (BuiltinBinaryCall  BuiltinListCall  BuiltinNullCall BuiltinNullOrUnaryCall BuiltinUnaryCall
48
                                   ExistsFunc IfExpression NotExistsFunc RegexExpression ReplaceExpression SubstringExpression)
49
   (or BuiltinNullCall BuiltinNullOrUnaryCall BuiltinBinaryCall BuiltinUnaryCall BuiltinListCall
50
       ExistsFunc NotExistsFunc
51
       RegexExpression ReplaceExpression IfExpression SubstringExpression))
52
 
53
 (defun |Clear-Constructor| (GrafRefAll Silence?)
54
   `(spocq.a:|clear| ,GrafRefAll ,@(unless Silence? `(:verbose t))))
55
 
56
 
57
 (defun |Collection-Constructor| (DottedNode GraphNode+)
58
   (let* ((tail (or DottedNode '|rdf|:|nil|))
59
         (triples nil))
60
     (dolist (node GraphNode+)
61
       (let ((cell (ecase *nondistinguished-marker-type*
62
                     (:blank-node (cons-blank-node "b"))
63
                     (:variable (cons-variable)))))
64
         (when (consp node)
65
           (setf triples (append node triples))
66
           (setf node (second (first node))))
67
         (push (list 'spocq.a:|triple| cell '|rdf|:|rest| tail) triples)
68
         (push (list 'spocq.a:|triple| cell '|rdf|:|first| node) triples)
69
         (setf tail cell)))
70
     triples))
71
 ;;; (parse-sparql "insert data { _:a <http://predicate> ( 1 2 ) }")
72
 ;;; (parse-sparql "insert data { (4 5) <http://predicate> ( (7 8) ) }")
73
 ;;; (parse-sparql "insert data { (4 5) <http://predicate> ( (7 8) 2 ) }")
74
 ;;; (parse-sparql "insert data { (4 5) <http://predicate> ( (7 8) (9 10) ) }")
75
 
76
 (defun |ConstrainedBlankNode-Constructor| (BlankNode)
77
   (assert spocq.i::*allow-blank-node-verb* ()
78
           "Blank nodes are not permitted as statement pattern verbs")
79
   BlankNode)
80
 
81
 (defun |ConstructClause-Constructor|  (ConstructTemplate Dimensions)
82
   `(spocq.a:|construct| ,ConstructTemplate ,Dimensions))
83
 
84
 (defun |ConstructQuery-Constructor| (ConstructTemplate DatasetClause* SolutionModifier TriplesTemplate? Var+ WhereClause Wild)
85
   "Assemble a construct operation either with an explict template or with the template 'inline'.
86
  Save the dataset specification when noe was provided in the request itself."
87
   
88
   (update-dataset-graphs DatasetClause* :query)
89
   (cond ((or ConstructTemplate Wild Var+)
90
          (when SolutionModifier
91
            (destructuring-bind (&key limit offset order group-by) SolutionModifier
92
              (declare (ignore group-by)) ; group can have no effect as there is no aggregation
93
              (when order
94
                (setf WhereClause `(spocq.a:|order| ,WhereClause ,order)))
95
              (when (or limit offset)
96
                (setf WhereClause `(spocq.a:|slice| ,WhereClause
97
                                                    ,@(when offset `(:offset ,offset))
98
                                                    ,@(when limit `(:count ,limit)))))))
99
          (cond (Wild                           ; build a construct pattern from all statements
100
                 (setf ConstructTemplate (let ((statements ()))
101
                                           (flet ((collect-statements (expression)
102
                                                    (if (bgp-form-p expression)
103
                                                      (dolist (statement (rest expression) t)
104
                                                        (when (triple-form-p statement)
105
                                                          (pushnew statement statements :test #'equalp)))
106
                                                      expression)))
107
                                             (declare (dynamic-extent #'collect-statements))
108
                                             (map-tree #'collect-statements WhereClause))
109
                                           (reverse statements))))
110
                (Var+                           ; build a construct pattern from all statements which intersect
111
                 (setf ConstructTemplate (let ((statements ()))
112
                                           (flet ((collect-statements (expression)
113
                                                    (if (bgp-form-p expression)
114
                                                      (dolist (statement (rest expression) t)
115
                                                        (when (and (triple-form-p statement)
116
                                                                   (intersection statement Var+))
117
                                                          (assert (every #'(lambda (term)
118
                                                                             (or (distinguished-variable-p term)
119
                                                                                 (spocq.e:constantp term)))
120
                                                                         (statement-terms statement))
121
                                                                  ()
122
                                                                  "Construct pattern statement may include terms and variables only: ~a."
123
                                                                  statement)
124
                                                          (pushnew statement statements :test #'equalp)))
125
                                                      expression)))
126
                                             (declare (dynamic-extent #'collect-statements))
127
                                             (map-tree #'collect-statements WhereClause))
128
                                           (reverse statements)))))
129
          `(spocq.a:|construct| ,WhereClause ,ConstructTemplate))
130
         (TriplesTemplate?
131
          (setf ConstructTemplate (copy-tree TriplesTemplate?))
132
          (let ((field-expression (cons 'spocq.a:|bgp| TriplesTemplate?)))
133
            (when SolutionModifier
134
              (destructuring-bind (&key limit offset order group-by) SolutionModifier
135
                (declare (ignore group-by)) ; group can have no effect as there is no aggregation
136
                (when (or limit offset)
137
                  (setf field-expression `(spocq.a:|slice| ,field-expression
138
                                                           ,@(when offset `(:offset ,offset))
139
                                                           ,@(when limit `(:count ,limit)))))
140
                (when order
141
                  (setf field-expression `(spocq.a:|order| ,field-expression ,order)))))
142
            `(spocq.a:|construct| ,field-expression ,ConstructTemplate)))
143
         (t
144
          '(spocq.a:|table| spocq.a:|unit|))))
145
 
146
 (defun |ConstructTemplate-Constructor| (ConstructQuads)
147
   ConstructQuads)
148
 
149
 (defun |ConstructQuads-Constructor| (ConstructQuads ConstructTriples VarOrIRIref)
150
   (append (if VarOrIRIref
151
               (loop for (nil subject predicate object) in ConstructTriples
152
                 collect `(spocq.a:|quad| ,subject ,predicate ,object ,VarOrIRIref))
153
               ConstructTriples)
154
           ConstructQuads))
155
 
156
 (defun |Copy-Constructor| (GraphOrDefaultx2 Silence?)
157
   `(spocq.a:|copy| ,@(reverse GraphOrDefaultx2) ,@(unless Silence? `(:verbose t))))
158
 
159
 (defun |Create-Constructor| (GrafRef Silence?)
160
   `(spocq.a:|create| ,GrafRef ,@(unless Silence? `(:verbose t))))
161
 
162
 (defun |DeleteClause-Constructor| (QuadPattern)
163
   `(:delete ,QuadPattern))
164
 
165
 (defun |DeleteData-Constructor| (QuadData)
166
   `(spocq.a:|deleteData| ,QuadData))
167
 
168
 (defun |DeleteWhere-Constructor| (QuadPattern)
169
   `(spocq.a:|deleteWhere| ,QuadPattern))
170
 
171
 (defun |DescribeClause-Constructor|  (Dimensions VarOrIRIref+)
172
   `(spocq.a:|describe| ,VarOrIRIref+ ,Dimensions))
173
 
174
 (defun |Dimensions-Constructor| (Var+)
175
   (reverse Var+))
176
 
177
 (defun |DottedNode-Constructor| (GraphNode)
178
   GraphNode)
179
 
180
 (defun |Drop-Constructor| (GrafRefAll Silence?)
181
   `(spocq.a:|drop| ,GrafRefAll ,@(unless Silence? `(:verbose t))))
182
 
183
 (defun |FieldClause-Constructor| (BindingsClause ValuesClause)
184
   "Accommodate both the bindings- and values-clause syntax, to them as either an addenda
185
  or as an inline solution field, as per productions ValuesClause (11) and InlineData (61)."
186
   (or BindingsClause ValuesClause))
187
 
188
 (defun |FirstTriplesTemplate-Constructor| (TriplesTemplate)
189
   TriplesTemplate)
190
 
191
 ;; supersede the 1.0 version 
192
 (defun |GraphNode-Constructor| (TriplesNode VarOrTermOrGroup)
193
   (or TriplesNode VarOrTermOrGroup))
194
 
195
 (defun |GraphRef-Constructor| (IRIRef)
196
   IRIRef)
197
 
198
 (defun |GraphOrDefault-Constructor| (GraphRef)
199
   (or GraphRef :default))
200
 
201
 (defun |GraphPatternNotTriples-Constructor| (GraphGraphPattern GroupOrUnionGraphPattern MinusGraphPattern OptionalGraphPattern RevisionGraphPattern ServiceGraphPattern)
202
   (or OptionalGraphPattern GroupOrUnionGraphPattern GraphGraphPattern MinusGraphPattern RevisionGraphPattern ServiceGraphPattern))
203
 
204
 (defun |GraphRefAll-Constructor| (GraphRef GraphRefKeyword)
205
   (or GraphRef GraphRefKeyword))
206
 
207
 (defun |GraphRefKeyword-Constructor| (item)
208
   ;; sbcl-1.0.46 w/ coverage choked on
209
   ;; (rest (assoc item '((spocq.s:all . :all) (spocq.s:default . :default) (spocq.s:named . :named)) :test #'string-equal))
210
   (cond ((string-equal item "all") :all)
211
         ((string-equal item "default") :default)
212
         ((string-equal item "named") :named)
213
         (t (error "Invalid graph reference: ~s." item))))
214
 
215
 (defun |GroupGraphPatternRest-Constructor| (Bind FieldClause Filter GraphPatternNotTriples TriplesBlock)
216
   (list* (or Bind Filter GraphPatternNotTriples
217
              (when FieldClause `(spocq.a:|bindings| ,@FieldClause)))
218
          (when TriplesBlock (list (cons 'spocq.a:|bgp| TriplesBlock)))))
219
 
220
 (defun |GroupGraphPatternSub-Constructor| (GroupGraphPatternRest* TriplesBlock)
221
   ;; filter scope is the entire group, optional is left associated and
222
   ;; an optional treats a missing intial triple block as a unit table
223
   (let ((unit '(spocq.a:|table| spocq.a:|unit|)))
224
     (when TriplesBlock
225
       (setf TriplesBlock (cons 'spocq.a:|bgp| TriplesBlock)))
226
     (cond (GroupGraphPatternRest*
227
            (let ((group TriplesBlock)
228
                  (filters ())
229
                  (sip-forms ()))
230
              (dolist (ggp-element (reverse GroupGraphPatternRest*))
231
                (destructuring-bind (gpnt-or-filter &optional triples-block) ggp-element 
232
                  (case (first gpnt-or-filter)
233
                    (:bind
234
                     (destructuring-bind (var expression) (rest gpnt-or-filter)
235
                       (setf group `(spocq.a:|extend| ,(or group unit) ,var ,expression))))
236
                    (:filter
237
                     (push (second gpnt-or-filter) filters))
238
                    (:minus
239
                     (setf group
240
                           (if group
241
                               `(spocq.a:|minus| ,group ,(second gpnt-or-filter))
242
                               ;; null minus anything is null
243
                               unit)))
244
                    (:optional
245
                     ;; as per 6.1 the optional may have no predecessor
246
                     (let* ((optional-group (second gpnt-or-filter))
247
                            (optional-filter (when (eq (first optional-group) 'spocq.a:|filter|)
248
                                               (third optional-group))))
249
                       (when optional-filter
250
                         (setf optional-group (second optional-group)))
251
                       (setf group
252
                             `(spocq.a:|leftjoin| ,(or group unit) ,optional-group
253
                                                  ,@(when optional-filter (list :test optional-filter))))))
254
                    (t
255
                     (cond ((and (or (spocq.i::service-form-p gpnt-or-filter)
256
                                     (spocq.i::revision-form-p gpnt-or-filter))
257
                                 (variable-p (second gpnt-or-filter)))
258
                            (push gpnt-or-filter sip-forms))
259
                           (group
260
                            (setf group 
261
                                  (cond ((and (bgp-form-p group) (bgp-form-p gpnt-or-filter))
262
                                         (cons 'spocq.a:|bgp| (append (rest gpnt-or-filter) (rest group))))
263
                                        (t
264
                                         `(spocq.a:|join| ,gpnt-or-filter ,group)))))
265
                           (t
266
                            (setf group gpnt-or-filter)))))
267
                  (when triples-block
268
                    ;; if the constituents are both bgps, then merge them
269
                    (setf group
270
                          (if group
271
                              (if (and (bgp-form-p group) (bgp-form-p triples-block))
272
                                  (cons 'spocq.a:|bgp| (append (rest triples-block) (rest group)))
273
                                  `(spocq.a:|join| ,triples-block ,group))
274
                              triples-block)))))
275
              (labels ((transform-sip (sip-form group)
276
                         (if (and group (not (spocq.i::table-form-p group)))
277
                             (destructuring-bind (op iri group-graph-pattern &rest args) sip-form
278
                               (if (or (spocq.i::service-form-p (first args))
279
                                       (spocq.i::revision-form-p (first args)))
280
                                   `(,op ,iri ,group-graph-pattern ,(transform-sip (first args) group) ,@(rest args))
281
                                   `(,op ,iri ,group-graph-pattern ,group ,@args)))
282
                             sip-form)))
283
                (loop for sip-form in sip-forms
284
                  ;; rearrange service forms which have a variable location
285
                  ;; do (print (list :group group :service service))
286
                  do (setf group (transform-sip sip-form group))))
287
              (if filters
288
                `(spocq.a:|filter| ,(or group unit)
289
                                   ,(if (rest filters)
290
                                      `(spocq.a:|exprlist| ,@(reverse filters))
291
                                      (first filters)))
292
                group)))
293
           (TriplesBlock )
294
           (t unit))))
295
 
296
 ;; introduce a bgp where a just a term was allowed
297
 (defun |GroupTemplate-Constructor| (ObjectVarOrTermOrGroup SubjectVarOrTermOrGroup TriplesTemplate Verb)
298
   (if TriplesTemplate
299
       (cons 'spocq.a:|bgp| TriplesTemplate)
300
       `(spocq.a:|bgp| (spocq.a:|triple| ,SubjectVarOrTermOrGroup ,Verb ,ObjectVarOrTermOrGroup))))
301
 
302
 (defun |InsertClause-Constructor| (QuadPattern)
303
   `(:insert ,QuadPattern))
304
 
305
 (defun |InsertData-Constructor| (QuadData)
306
   `(spocq.a:|insertData| ,QuadData))
307
 
308
 (defun |Lambda-Constructor| (Expression* Var*)
309
   `(lambda ,Var* ,@Expression*))
310
 
311
 (defun |Load-Constructor| (GraphRef IRIRef Silence?)
312
   `(spocq.a:|load| ,IRIRef ,GraphRef ,@(unless Silence? `(:verbose t))))
313
 
314
 (defun |MemberOperator-Constructor| (NotIn)
315
   (or NotIn 'spocq.a:|in|))
316
 
317
 (defun |Modify-Constructor| (DeleteClause GroupGraphPattern InsertClause IRIRef? UsingClause*)
318
   (let ((graph-clauses ()))
319
     (loop for (key used) in UsingClause*
320
           do (ecase key
321
                ((:from :using) (push used (getf graph-clauses :graphs)))
322
                ((:from-named :using-named) (push used (getf graph-clauses :named-graphs)))))
323
     (destructuring-bind (&key named-graphs graphs) graph-clauses
324
       (setf named-graphs (or (request-argument :named-graphs) named-graphs))
325
       (setf graphs (or (request-argument :default-graphs) graphs))
326
       `(spocq.a:|modify| ,GroupGraphPattern
327
                           ,@DeleteClause
328
                           ,@InsertClause
329
                           ,@(when IRIRef? `(:with ,IRIRef?))
330
                           ,@(when graphs `(:graphs ,graphs))
331
                           ,@(when named-graphs `(:named-graphs ,named-graphs))))))
332
 
333
 (defun |Move-Constructor| (GraphOrDefaultx2 Silence?)
334
   `(spocq.a:|move| ,@(reverse GraphOrDefaultx2) ,@(unless Silence? `(:verbose t))))
335
 
336
 (defun |NamedIRIref-Constructor| (IRIRef)
337
   IRIRef)
338
 
339
 (defun |NotIn-Constructor| ()
340
   'spocq.a:|notin|)
341
 
342
 (defun |Pragma-Constructor| (PragmaArgList VARNAME)
343
   "Pragmas are declarations and configuration instructions which are handled on-the-fly at the start
344
  of parsing the given query. Each operator can accept its own argument complement."
345
 
346
   (loop for value in PragmaArgList
347
         do (set-pragma VARNAME value)))
348
         
349
 (defun |PragmaArgList-Constructor| (NILLIST PragmaArg*)
350
   (declare (ignore NILLIST))
351
   (when PragmaArg*
352
     (reverse PragmaArg*)))
353
 
354
 (defun |PragmaArg-Constructor| (Expression VARNAME)
355
   (or Expression VARNAME))
356
 
357
 (defun |PrefixDecl-Constructor| (IRI_REF_NAMESTRING PNAME_NS)
358
   ;; allow simple pragmas as prefix declarations
359
   (unless (set-pragma PNAME_NS IRI_REF_NAMESTRING)
360
     (setf (prefix-namespace PNAME_NS) IRI_REF_NAMESTRING))
361
   (list PNAME_NS IRI_REF_NAMESTRING))
362
 
363
 (defun |Prologue-Constructor| (BaseDecl Pragma PrefixDecl)
364
   (or BaseDecl PrefixDecl Pragma))
365
 
366
 (defun |QuadPattern-Constructor| (Quads)
367
   Quads)
368
 
369
 (defun |QuadData-Constructor| (Quads)
370
   (let ((variables (spocq.i::expression-variables Quads)))
371
     ;; replace indistinguished variables with unique blank nodes
372
     (when variables
373
       (setf Quads
374
             (sublis (loop for variable in variables
375
                       when (spocq.i::undistinguished-variable-p variable)
376
                       do (setf variables (remove variable variables))
377
                       collect (cons variable
378
                                     (spocq.i::cons-global-blank-node :prefix "DATA-")))
379
                    Quads)))
380
     (if variables
381
         (case spocq.i::*quad-data-variable-behavior*
382
           ((nil |urn:dydra|:|error|)
383
            (error "QuadData may not contain variables: ~s."
384
                   (subseq quads 0 (min 32 (length quads)))))
385
           (|urn:dydra|::|iri|
386
            (sublis (loop for variable in variables
387
                      collect (cons variable
388
                                    (intern-iri (format nil "urn:sparql:variable?=name=~a" variable))))
389
                    Quads)))
390
         Quads)))
391
 
392
 (defun flatten-triples (sequence)
393
   (collect-list (collect)
394
     (labels ((do-flatten (sequence)
395
                (case (first sequence)
396
                  ((spocq.a:|graph| spocq.a:|triple|)
397
                   (collect sequence))
398
                  (t
399
                   (dolist (sub sequence) (do-flatten sub))))))
400
       (do-flatten sequence))))
401
 
402
 (defun |Quads-Constructor| (Quads? TriplesOrQuads)
403
   "This returns a list of the quads without any modification for joins etc."
404
   (when (graph-form-p TriplesOrQuads)
405
     (setf TriplesOrQuads (list TriplesOrQuads)))
406
   (append TriplesOrQuads Quads?))
407
       
408
 
409
 #+(or)
410
 (defun |Quads-Constructor| (RestQuads* TriplesTemplate?)
411
   "This returns a list of the quads qithout any modification for joins etc."
412
   (flatten-triples (cons TriplesTemplate? (reverse RestQuads*))))
413
 
414
 (defun |QuadsNotTriples-Constructor| (TriplesTemplate? VarOrIRIref)
415
   `(spocq.a:|graph| ,VarOrIRIref ,TriplesTemplate?))
416
 
417
 (defun |Query-Constructor| (AskQuery ConstructQuery DescribeQuery FieldClause? SelectQuery)
418
   ;; 1.1 added an optional bindings clause. the CR moved it from the select production to the query construction
419
   ;; evidently with the intent to have it act in the position of a solution modifier for all query forms.
420
   ;; also, the prologue is shared by query and update, so promoted to the sparql constructor
421
   ;; on bindings :
422
   ;;  http://lists.w3.org/Archives/Public/public-rdf-dawg/2010JulSep/0370.html
423
   ;;  http://lists.w3.org/Archives/Public/public-rdf-dawg/2011JanMar/0005.html
424
   (let ((base-clause (or AskQuery ConstructQuery DescribeQuery SelectQuery)))
425
     (if FieldClause?
426
       (destructuring-bind (operator solution-field &rest rest)
427
                           base-clause
428
         `(,operator (spocq.a:|join| (spocq.a:|bindings| ,@FieldClause?) ,solution-field) ,@rest))
429
       base-clause)))
430
 
431
 (defun |RelatedNumeric-Constructor| (ExpressionList MemberOperator NumericExpression RelationalOperator)
432
   (if MemberOperator
433
     `(,MemberOperator ,ExpressionList)
434
     `(,RelationalOperator ,NumericExpression)))
435
 
436
 (defun |ReplaceExpression-Constructor| (Expression++?)
437
   `(spocq.a:|replace| ,@(reverse Expression++?)))
438
 
439
 (defun |RestQuads-Constructor| (QuadsNotTriples TriplesTemplate?)
440
   (cond (TriplesTemplate?
441
          (cons QuadsNotTriples TriplesTemplate?))
442
         (QuadsNotTriples )
443
         (t
444
          (assert QuadsNotTriples ()
445
                  "Invalid reduction (RestQuads): QuadsNotTriples is required."))))
446
 
447
 
448
 (defun |RevisionGraphPattern-Constructor| (GroupGraphPattern String VarOrIRI)
449
   `(spocq.a:|revision| ,(or VarOrIRI String) ,GroupGraphPattern))
450
 
451
 (defun |ServiceGraphPattern-Constructor| (GroupGraphPattern Silence? VarOrIRI)
452
   (declare (special sparql-1-0-4::|ServiceGraphPattern-INDEX|))
453
   (flet ((extract-ggp (tokens)
454
            (loop for token in tokens
455
                  with level = 0
456
                  if (eql token 'SPOCQ.S:{)
457
                  collect token and do (incf level)
458
                  else if (eql token 'SPOCQ.S:})
459
                  collect token and do (decf level)
460
                  else collect token
461
                  while (plusp level)))
462
          (subselect-p (tokens)
463
            (and (eq (pop tokens) 'SPOCQ.S:{) (eq (pop tokens) 'SPOCQ.S:SELECT))))
464
     (let* ((tokens (spocq.i::input-tokens sparql-1-0-4::|ServiceGraphPattern-INDEX|))
465
            (ggp-tokens (extract-ggp (member 'SPOCQ.S:{ tokens)))
466
            (text (if (subselect-p ggp-tokens)
467
                    (spocq.i::untokenize-sparql (rest (butlast ggp-tokens)))
468
                    (concatenate 'string "select * where " (spocq.i::untokenize-sparql ggp-tokens)))))
469
       (assert ggp-tokens ()
470
               "invalid group graph pattern: ~s." (spocq.i::untokenize-sparql tokens))
471
       `(spocq.a:|service| ,VarOrIRI ,GroupGraphPattern
472
                           :query-text ,text
473
                           ,@(when Silence? `(:silent t))))))
474
 
475
 (defun |Silence-Constructor| (item)
476
   item)
477
 
478
 ;; temporary until changed bnf
479
 (defun |SourceSelector-Constructor| (GraphRefKeyword &optional (IRIref :none))
480
   (if (eq IRIref :none)
481
       GraphRefKeyword
482
       (cond (IRIref)
483
             (GraphRefKeyword
484
              (ecase GraphRefKeyword
485
                (:all |urn:dydra|:|all|)
486
                (:default |urn:dydra|:|default|)
487
                (:named |urn:dydra|:|named|))))))
488
 
489
 (defun |SubSelect-Constructor| (&rest args)
490
   (ecase (length args)
491
     (6 (destructuring-bind (ConstructClause DescribeClause FieldClause? SelectClause SolutionModifier WhereClause) args
492
          (cond (ConstructClause
493
                 (destructuring-bind (ConstructTemplate Dimensions) (rest ConstructClause)
494
                   (append (|ConstructQuery-Constructor| ConstructTemplate nil SolutionModifier nil nil WhereClause nil)
495
                           (when Dimensions (list Dimensions)))))
496
                (DescribeClause
497
                 (destructuring-bind (VarOrIRIref+ Dimensions) (rest DescribeClause)
498
                   (append (|DescribeQuery-Constructor| nil SolutionModifier VarOrIRIref+ WhereClause)
499
                           (when Dimensions (list Dimensions)))))
500
                (t
501
                 (org.datagraph.spocq.sparql-1-0-2::construct-select :SelectClause SelectClause
502
                                                                     :SolutionModifier SolutionModifier
503
                                                                     :WhereClause (if FieldClause?
504
                                                                                      `(spocq.a:|join| (spocq.a:|bindings| ,@FieldClause?) ,WhereClause)
505
                                                                                      WhereClause))))))
506
     (4 (destructuring-bind (FieldClause? SelectClause SolutionModifier WhereClause) args
507
          (org.datagraph.spocq.sparql-1-0-2::construct-select :SelectClause SelectClause
508
                                                              :SolutionModifier SolutionModifier
509
                                                              :WhereClause (if FieldClause?
510
                                                                               `(spocq.a:|join| (spocq.a:|bindings| ,@FieldClause?) ,WhereClause)
511
                                                                               WhereClause)))))
512
   )
513
 
514
 (defun |TriplesBlockRest-Constructor| (TriplesSameSubject)
515
   TriplesSameSubject)
516
 
517
 (defun |TriplesTemplateRest-Constructor| (TriplesSameSubject)
518
   TriplesSameSubject)
519
 
520
 (defun |TriplesBlock-Constructor| (TriplesBlockRest* TriplesSameSubject)
521
   (flatten-triples (if TriplesBlockRest*
522
                      (append TriplesSameSubject TriplesBlockRest*)
523
                      TriplesSameSubject)))
524
 
525
 #+(or)
526
 (defun |TriplesTemplate-Constructor| (TriplesSameSubject TriplesTemplateRest*)
527
   (flatten-triples (if TriplesTemplateRest*
528
                      (append TriplesSameSubject TriplesTemplateRest*)
529
                      TriplesSameSubject)))
530
 
531
 (defun |TriplesOrQuads-Constructor| (QuadsNotTriples TriplesTemplate)
532
   (or QuadsNotTriples TriplesTemplate))
533
 
534
 (defun |TriplesSameSubject-Constructor| (Annotation PropertyList PropertyListNotEmpty TriplesNode VarOrTermOrGroup)
535
   ;; PropertyList PropertyListNotEmpty are different non-terminals for the same form in different contexts
536
   (flet ((generate-triples (subject verb-object-list)
537
            (loop for (verb object) in verb-object-list
538
                  append (if (consp object)
539
                             (cond ((bgp-form-p object) ;; if it is a nested bgp, leave it
540
                                    `((spocq.a:|triple| ,subject ,verb ,object)))
541
                                   ((triple-form-p object) ;; integrate a single triple
542
                                    (cons `(spocq.a:|triple| ,subject ,verb ,(second object))
543
                                          object))
544
                                   (t ;; extract the subject from a same-subject list
545
                                    (unless (triple-form-p (first object))
546
                                      (warn "invalid TriplesSameSubject object: ~s" object))
547
                                    (cons `(spocq.a:|triple| ,subject ,verb ,(second (first object)))
548
                                          object)))
549
                             `((spocq.a:|triple| ,subject ,verb ,object))))))
550
     (let ((triples (cond (TriplesNode
551
                           (if (eq TriplesNode '|rdf|:|nil|)
552
                               (loop for (verb object) in PropertyList
553
                                 collect `(spocq.a:|triple| ,TriplesNode ,verb ,object))
554
                               (if PropertyList
555
                                   (append (generate-triples (second (first TriplesNode)) PropertyList)
556
                                           TriplesNode)
557
                                   TriplesNode)))
558
                          (VarOrTermOrGroup
559
                           ;; expand the property lists. these will be either simple verb object, or verb with nested object
560
                           (generate-triples VarOrTermOrGroup PropertyListNotEmpty))
561
                          (t
562
                           (error "One of |TriplesNode| |VarOrTermOrGroup| is required.")))))
563
       (if Annotation
564
           (generate-triples (cons 'spocq.a:|bgp| triples) Annotation)
565
           triples))))
566
 
567
 (defun |TriplesTemplate-Constructor| (TriplesSameSubject TriplesTemplate)
568
   (append (flatten-triples TriplesSameSubject) TriplesTemplate))
569
 
570
 (defun |Sparql-Constructor| (Prologue* Query Update)
571
   (declare (ignore Prologue*))
572
   (or Query Update))
573
 
574
 (defun |Update-Constructor| (Update? Update1)
575
   `(spocq.a:|update| ,Update1 ,@(cdr Update?)))
576
 
577
 (defun |Update1-Constructor| (Add Clear Copy DeleteData DeleteWhere Drop Create InsertData Load Modify Move)
578
   (or Add Clear Copy DeleteData DeleteWhere Drop Create InsertData Load Modify Move))
579
 
580
 (defun |UsingClause-Constructor| (IRIref NamedIRIref)
581
   (cond (IRIRef
582
          `(:using ,IRIref))
583
         (NamedIRIref
584
          `(:using-named ,NamedIRIref))
585
         (t
586
          (assert (or IRIref NamedIRIref) ()
587
                  "Invalid reduction (UsingClause): One of IRIref NamedIRIref is required."))))
588
 
589
 (defun |ValuesClause-Constructor| (clause)
590
   clause)
591
 
592
 (defun |ValuesData-Constructor| (BindingList* BindingValue* Var VarList)
593
   (cond (Var
594
          ;; a single variable with one value per solution
595
          (|BindingsClause-Constructor| (mapcar #'list BindingValue*) (list Var)))
596
         (VarList
597
          (|BindingsClause-Constructor| BindingList* VarList))
598
         (t
599
          ;; provide a null field
600
          (|BindingsClause-Constructor| nil nil))))
601
 
602
 (defun |VarList-Constructor| (Var*)
603
   ;; do not reverse it, the bindings clause constructor reverses both arguments
604
   Var*)
605
 
606
 (defun |VariableOrBindingOrAggregate-Constructor| (Aggregate Expression Var)
607
   (if Aggregate
608
     (let ((operator (first aggregate)))
609
       `(,(cons-symbol *variable-package* (string operator) (princ-to-string (next-variable-index)))
610
         ,aggregate))
611
     (if Expression
612
       `(,Var ,Expression)
613
       Var)))
614
 
615
 (defun |VARNAME-Constructor| (item)
616
   item)
617
 
618
 (defun |VarOrTermOrGroup-Constructor| (|GraphTerm| |GroupTemplate| |Var|)
619
   (or |GraphTerm| |GroupTemplate| |Var|))
620
 
621
 (defun |VarOrTerm-Constructor| (|GraphTerm| |Var|)
622
   (or |GraphTerm| |Var|))
623
 
624
 (defun |ObjectVarOrTermOrGroup-Constructor| (VarOrTermOrGroup)
625
   VarOrTermOrGroup)
626
 
627
 (defun |SubjectVarOrTermOrGroup-Constructor| (VarOrTermOrGroup)
628
   VarOrTermOrGroup)
629
 
630
 (defun |Verb-Constructor| (ConstrainedBlankNode Path VarOrIRIref)
631
   "Add the option of a constrained blank node as a verb"
632
   (or ConstrainedBlankNode Path VarOrIRIref |http://www.w3.org/1999/02/22-rdf-syntax-ns#|:|type|))
633
 
634
 
635
 (defclass sparql-atn (bnfp:atn)
636
   ((ambiguous-rules
637
     :initform '(|Verb|
638
                 |Path|
639
                 |PathAlternative|
640
                 |PathSequence|
641
                 |PathElt|
642
                 |PathEltOrInverse|
643
                 |InvertedPathElt|
644
                 |PathMod|
645
                 |PathCardinality|
646
                 |PathRange|
647
                 |PathRangeStart|
648
                 |PathRangeEnd|
649
                 |PathRangeCount|
650
                 |PathPrimary|
651
                 |PathNegatedPropertySet|
652
                 |PathOneInPropertySet|
653
                 |PathVerb|
654
                 |PathInvertOp|)
655
     :reader atn-ambiguous-rules)))
656
 
657
 (defmethod bnfp::atn-ambiguous ((node sparql-atn) current-state)
658
   (if (member (bnfp:atn-name node) (atn-ambiguous-rules node))
659
     t
660
     current-state))
661
 
662
 #+(or)
663
 (progn
664
 ;;; to translate the bnf into lisp
665
 ;;; likely in a listener as this file's package does not exist at the outset
666
 ;;; is may already be present in the image
667
 (asdf:load-system :de.setf.atn-parser)
668
 (asdf:load-system :de.setf.utility.codecs)
669
 (asdf:load-system :cl-ppcre)
670
 (setq atnp::*wfst-size* 3200)
671
 (setq atnp::*wfst* (make-array atnp::*wfst-size* :initial-element nil))
672
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;package.lisp")        ; may fail, missing packages
673
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;package-1-0.lisp")
674
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;package-1-0-1.lisp")
675
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;package-1-0-2.lisp")
676
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;package-1-0-3.lisp")
677
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;package-1-0-4.lisp")
678
 (load #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;ssf-sparql-lexer.lisp")
679
 
680
 (in-package :SPARQL-1-0-4) ;; 1-0-5 is in the same package
681
 ;; load any constructor extensions
682
 ;; (load #p"/development/source/library/org/datagraph/spocq/src/patches/20151006-sub-describe.lisp")
683
 (let ((bnfp:*class.atn* 'sparql-atn)
684
       (bnfp:*class.atn-node* bnfp:*class.atn-node*)
685
       (bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)
686
       (bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)
687
       (bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)
688
       (bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))
689
   (bnfp:compile-atn-system  ;; #p"P-LIBRARY:org;datagraph;spocq-page-ring;src;core;encoding;sparql-1-0-4.bnf"
690
                             ;; #p"org/datagraph/spocq/src/core/encoding/sparql-1-0-4.bnf"
691
                             ;; #p"org/datagraph/spocq-dev/src/core/encoding/sparql-1-0-5.bnf"
692
                             #p"org/datagraph/spocq-dev/src/core/encoding/sparql-1-0-5-formula.bnf"
693
                             :execute t :compile nil
694
                             :token-package (find-package :spocq.s)
695
                             :source-package (find-package :sparql-1-0-4)
696
                             :source-pathname "LIBRARY:org;datagraph;spocq-dev;src;core;encoding;sparql-1-0-5-formula.lisp"
697
                             :input-function 'input-reference
698
                             :input-eof-function 'input-eof?
699
                             :ambiguous t        ; the property paths make it ambiguous
700
                          ;;   :ambiguous nil
701
                             :trace nil))
702
 
703
 ;;; to compile the parser state machine manually
704
 (load (compile-file #p"LIBRARY:org;datagraph;spocq-dev;src;core;encoding;sparql-1-0-5.lisp"))
705
 
706
 
707
 
708
 ;;; generate the grammar's atn definition
709
 (let ((bnfp:*class.atn* bnfp:*class.atn*)
710
       (bnfp:*class.atn-node* bnfp:*class.atn-node*)
711
       (bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)
712
       (bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)
713
       (bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)
714
       (bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))
715
   (atnp::print-atn-system #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-4.bnf"
716
                           :source-package (find-package :sparql-1-0-4)))
717
 
718
 (let ((bnfp:*class.atn* bnfp:*class.atn*)
719
       (bnfp:*class.atn-node* bnfp:*class.atn-node*)
720
       (bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)
721
       (bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)
722
       (bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)
723
       (bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))
724
   (atnp::graph-atn-system #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-4.bnf"
725
                           :source-package (find-package :sparql-1-0-4)))
726
 
727
 ;;; 2018-02-05 test aggregation extensions
728
 (spocq.i::parse-sparql "select (corr(strlen(str(?s1)), strlen(str(?s2))) as ?corr) where {?s ?pred ?s1 . ?s ?pred ?s2}")
729
 (spocq.i::test-sparql "select (corr(strlen(str(?s1)), strlen(str(?s2))) as ?corr) where {?s ?pred ?s1 . ?s ?pred ?s2}"
730
    :repository-id "james/foaf")
731
 
732
 
733
 (parse-sparql "select *
734
 where {
735
  _:s1 <http://example.org/predicate> 3 .
736
 }")
737
 
738
 ;;; original syntax with blank node subject
739
 (pprint-sse
740
 (parse-sparql "select *
741
 where {
742
  [ <http://example.org/superpred1> 0 , 1 ;
743
        <http://example.org/superpred2> 2]
744
    <http://example.org/predicate> 3 .
745
 }"))
746
 
747
 (select
748
  (bgp
749
    {??1 <http://example.org/predicate> 3}
750
    {??1 <http://example.org/superpred1> 0}
751
    {??1 <http://example.org/superpred1> 1}
752
    {??1 <http://example.org/superpred2> 2})
753
  COMMON-LISP:NIL)
754
 
755
 
756
 ;;; formula subject
757
 
758
 (pprint-sse
759
 (parse-sparql "select *
760
 where {
761
  {_:f1 <http://example.org/superpred1> 0 , 1 ;
762
        <http://example.org/superpred2> 2}
763
    <http://example.org/predicate> 3 .
764
 }"))
765
 
766
 (select
767
  (bgp
768
    {(bgp (triple <_:f1> <http://example.org/superpred1> 0) (triple <_:f1> <http://example.org/superpred1> 1) (triple <_:f1> <http://example.org/superpred2> 2)) <http://example.org/predicate> 3})
769
  COMMON-LISP:NIL)
770
 
771
 
772
 ;;; sparql* subject
773
 (pprint-sse
774
 (parse-sparql "select *
775
 where {
776
  <<_:f1 <http://example.org/superpred1> 0 >>
777
    <http://example.org/predicate> 3 .
778
 }"))
779
 
780
 (select
781
  (bgp
782
    {(bgp (triple <_:f1> <http://example.org/superpred1> 0)) <http://example.org/predicate> 3})
783
  COMMON-LISP:NIL)
784
 
785
 
786
 ;;; original syntax w/ blank node object
787
 (pprint-sse
788
 (parse-sparql "select *
789
 where {
790
  <http://example.org/subject>
791
    <http://example.org/predicate>
792
  [<http://example.org/superpred1> 0 , 1 ;
793
        <http://example.org/superpred2> 2].
794
 }"))
795
 
796
 (select
797
  (bgp
798
    {<http://example.org/subject> <http://example.org/predicate> ??1}
799
    {??1 <http://example.org/superpred1> 0}
800
    {??1 <http://example.org/superpred1> 1}
801
    {??1 <http://example.org/superpred2> 2})
802
  COMMON-LISP:NIL)
803
 
804
 
805
 ;;; formula object
806
 (pprint-sse
807
 (parse-sparql "select *
808
 where {
809
  <http://example.org/subject>
810
    <http://example.org/predicate>
811
  {_:f1 <http://example.org/superpred1> 0 , 1 ;
812
        <http://example.org/superpred2> 2}.
813
 }"))
814
 
815
 (select
816
  (bgp
817
    {<http://example.org/subject> <http://example.org/predicate> (bgp (triple <_:f1> <http://example.org/superpred1> 0) (triple <_:f1> <http://example.org/superpred1> 1) (triple <_:f1> <http://example.org/superpred2> 2))})
818
  COMMON-LISP:NIL)
819
 
820
 
821
 ;;; sparql* object
822
 (pprint-sse
823
 (parse-sparql "select *
824
 where {
825
  <http://example.org/subject>
826
    <http://example.org/predicate>
827
  <<_:f1 <http://example.org/superpred1> 0 >>.
828
 }"))
829
 
830
 (select
831
  (bgp
832
    {<http://example.org/subject> <http://example.org/predicate> (bgp (triple <_:f1> <http://example.org/superpred1> 0))})
833
  COMMON-LISP:NIL)
834
 
835
 
836
 (pprint-sse
837
 (parse-sparql "select *
838
 where {
839
  <http://example.org/subject> <http://example.org/predicate>
840
  {_:f1 <http://example.org/subpred1>
841
     { _:f2 <http://example.org/subpred2> ?o } }
842
 }"))
843
 
844
 (select
845
  (bgp
846
    {<http://example.org/subject> <http://example.org/predicate> (bgp (triple <_:f1> <http://example.org/subpred1> (bgp (triple <_:f2> <http://example.org/subpred2> ?::o))))})
847
  COMMON-LISP:NIL)
848
 
849
 
850
   (pprint-sse
851
    (parse-sparql "
852
 select *
853
 where {
854
 <http://example.org/subject> <http://example.org/predicate> <http://example.org/object>
855
 { <http://example.org/subpred1> ?o }
856
 }"))
857
 
858
   (send-response-message :query (parse-sparql "
859
 select *
860
 where {
861
 <http://example.org/subject> <http://example.org/predicate> <http://example.org/object>
862
 { <http://example.org/subpred1> ?o }
863
 }") *trace-output* mime:application/vnd.dydra.sparql-query-algebra)
864
 
865
   (select
866
  (bgp
867
    {(bgp (triple <http://example.org/subject> <http://example.org/predicate> <http://example.org/object>)) <http://example.org/subpred1> ?o})
868
  (?o))
869
 
870
   (parse-term "{ <http://example.org/subpred1> ?o }" :production 'org.datagraph.spocq.sparql-1-0-4::|Annotation|)
871
 
872
   ((<http://example.org/subpred1> ?::|o|))
873
 
874
   (pprint-sse
875
    (parse-term "
876
 <http://example.org/subject> <http://example.org/predicate> <http://example.org/object>
877
  { <http://example.org/subpred1> ?o }"
878
                :production 'org.datagraph.spocq.sparql-1-0-4::|TriplesSameSubject|))
879
 
880
   ({(bgp (triple <http://example.org/subject> <http://example.org/predicate> <http://example.org/object>)) <http://example.org/subpred1> ?o})
881
 
882
   ((ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple|
883
                                 (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
884
                                                              (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple| <http://example.org/subject>
885
                                                                                           <http://example.org/predicate>
886
                                                                                           <http://example.org/object>))
887
                                 <http://example.org/subpred1> ?::|o|))
888
 
889
 (send-response-message :query (parse-sparql "
890
 prefix star: <http://rdf-star/>
891
 select *
892
 where {
893
 <http://e.o/subject> star:p/star:q <http://e.o/object>
894
 { <http://e.o/r> ?o }
895
 }") *trace-output* mime:application/vnd.dydra.sparql-query-algebra)
896
 
897
 Project(BGP( BGP( <http://example.org/subject> (<https://github.com/w3c/rdf-star/p>/<https://github.com/w3c/rdf-star/q>) <http://example.org/object>) <http://example.org/subpred1> ?o),
898
         {?o})
899
 
900
 
901
 (send-response-message :query (parse-sparql "
902
 prefix : <http://rdf-star/>
903
 ASK { ?x :p* ?y { :a :b }
904
 }") *trace-output* mime:application/vnd.dydra.sparql-query-algebra)
905
 
906
 
907
 
908
 )