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

KindCoveredAll%
expression50176 28.4
branch928 32.1
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-3; -*-
2
 
3
 (in-package :org.datagraph.spocq.sparql-1-0-3)
4
 
5
 (:documentation "SPARQL parser reduction operations v1.0.3"
6
  "These operators add support for
7
   - property paths
8
   - minus
9
  ")
10
 
11
 ;;; reduction operators added by 1.0.3
12
 
13
 (defun |GraphPatternNotTriples-Constructor| (GraphGraphPattern GroupOrUnionGraphPattern MinusGraphPattern OptionalGraphPattern)
14
   (or OptionalGraphPattern GroupOrUnionGraphPattern GraphGraphPattern MinusGraphPattern))
15
 
16
 (defun |GroupGraphPatternSub-Constructor| (GroupGraphPatternRest* TriplesBlock)
17
   ;; filter scope is the entire group, optional is left associated and
18
   ;; an optional treats a missing intial triple block as a unit table
19
   (let ((unit '(spocq.a:|table| spocq.a:|unit|)))
20
     (cond (GroupGraphPatternRest*
21
            (let ((group TriplesBlock)
22
                  (filters ()))
23
              (dolist (ggp-element (reverse GroupGraphPatternRest*))
24
                (destructuring-bind (gpnt-or-filter &optional triples-block) ggp-element 
25
                  (case (first gpnt-or-filter)
26
                    (:bind
27
                     (destructuring-bind (var expression) (rest gpnt-or-filter)
28
                       (setf group `(spocq.a:|extend| ,group ,var ,expression))))
29
                    (:filter
30
                     (push (second gpnt-or-filter) filters))
31
                    (:minus
32
                     (setf group `(spocq.a:|minus| ,group ,(second gpnt-or-filter))))
33
                    (:optional
34
                     ;; as per 6.1 the optional may have no predecessor
35
                     (let* ((optional-group (second gpnt-or-filter))
36
                            (optional-filter (when (eq (first optional-group) 'spocq.a:|filter|)
37
                                               (third optional-group))))
38
                       (when optional-filter
39
                         (setf optional-group (second optional-group)))
40
                       (setf group
41
                             `(spocq.a:|leftjoin| ,(or group unit) ,optional-group
42
                                                  ,@(when optional-filter (list :test optional-filter))))))
43
                    (t
44
                     (setf group
45
                           (if group
46
                             `(spocq.a:|join| ,group ,gpnt-or-filter)
47
                             gpnt-or-filter))))
48
                  (when triples-block
49
                    (setf group
50
                          (if group `(spocq.a:|join| ,group ,triples-block) triples-block)))))
51
              (if filters
52
                `(spocq.a:|filter| ,(or group unit)
53
                                   ,(if (rest filters)
54
                                      `(spocq.a:|exprlist| ,@(reverse filters))
55
                                      (first filters)))
56
                group)))
57
           (TriplesBlock)
58
           (t unit))))
59
 
60
 (defun |InvertedPathElt-Constructor| (PathElt)
61
   PathElt)
62
 
63
 (defun |MinusGraphPattern-Constructor| (GroupGraphPattern)
64
   `(:minus ,GroupGraphPattern))
65
 
66
 (defun |Path-Constructor| (PathAlternative)
67
   ;; if the path reduces to a single verb, return just the respective iri
68
   (typecase PathAlternative
69
     (spocq.i::property-path-verb (spocq.i::property-path-verb-iri PathAlternative))
70
     (t PathAlternative)))
71
 
72
 (defun |PathAlternative-Constructor| (PathSequence+)
73
   (if (rest PathSequence+)
74
     (spocq.i:make-or-property-path :elements (reverse PathSequence+))
75
     (first PathSequence+)))
76
 
77
 (defun |PathCardinality-Constructor| (cardinality)
78
   cardinality)
79
 
80
 (defun |PathElt-Constructor| (PathMod? PathPrimary)
81
   (if PathMod?
82
     (destructuring-bind (&key min max) PathMod?
83
       (cond ((and (eql min 0) (eql max 0))
84
              (make-zero-length-property-path :element PathPrimary))
85
             ((and (eql min 1) (eql max 1))
86
              PathPrimary)
87
             (t
88
              (apply #'make-bounded-property-path :element PathPrimary PathMod?))))
89
     PathPrimary))
90
 
91
 (defun |PathEltOrInverse-Constructor| (InvertedPathElt PathElt)
92
   (cond (InvertedPathElt
93
          (spocq.i:make-inverted-property-path :element InvertedPathElt))
94
         (PathElt )
95
         (t
96
          (error "one of InvertedPathElt or PathElt is required."))))
97
 
98
 (defun |PathInvertOp-Constructor| (op)
99
   op)
100
 
101
 (defun |PathMod-Constructor| (PathCardinality PathRange)
102
   (ecase PathCardinality
103
     (spocq.s::? `(:min 0 :max 1))
104
     (spocq.s::* `(:min 0 :max nil))
105
     (spocq.s::+ `(:min 1 :max nil))
106
     ((nil) PathRange)))
107
 
108
 (defun |PathNegatedPropertySet-Constructor| (PathOneInPropertySet+)
109
   (if (rest PathOneInPropertySet+)
110
     (spocq.i:make-negated-property-path :element (spocq.i:make-or-property-path :elements (reverse PathOneInPropertySet+)))
111
     (spocq.i:make-negated-property-path :element (first PathOneInPropertySet+))))
112
 
113
 (defun |PathOneInPropertySet-Constructor| (PathInvertOp PathVerb)
114
   (if PathInvertOp
115
     (spocq.i:make-inverted-property-path :element PathVerb)
116
     PathVerb))
117
 
118
 (defun |PathPrimary-Constructor| (Path PathNegatedPropertySet PathVerb)
119
   (cond (Path
120
          (if (spocq.i::iri-p Path)
121
            (spocq.i::make-property-path-verb :iri Path)
122
            Path))
123
         (PathNegatedPropertySet)
124
         (PathVerb)))
125
 
126
 (defun |PathRange-Constructor| (RangeCount RangeEnd RangeStart)
127
   (cond (RangeCount
128
          (assert (typep RangeCount '(or null (integer 0))) ()
129
                  "Invalid range parameter {~a}")
130
          `(:min ,RangeCount :max ,RangeCount))
131
         (t
132
          (assert (and (typep RangeStart '(or null (integer 0)))
133
                       (typep RangeEnd '(or null (integer 0)))
134
                       (or (not (and RangeStart RangeEnd))
135
                           (>= RangeEnd RangeStart)))
136
                  ()
137
                  "Invalid range parameters {~@[~a~],~@[~a~]}" RangeStart RangeEnd)
138
          `(:min ,(or RangeStart 0) :max ,RangeEnd))))
139
 
140
 (defun |PathRangeCount-Constructor| (integer)
141
   integer)
142
 
143
 (defun |PathRangeEnd-Constructor| (integer)
144
   integer)
145
 
146
 (defun |PathRangeStart-Constructor| (integer)
147
   integer)
148
 
149
 (defun |PathSequence-Constructor| (PathEltOrInverse+)
150
   (if (rest PathEltOrInverse+)
151
     (spocq.i:make-sequence-property-path :elements (reverse PathEltOrInverse+))
152
     (first PathEltOrInverse+)))
153
 
154
 (defun |PathVerb-Constructor| (IRIRef)
155
   ;; cannot instantiate yet, as it may contribute to a word edge, or to a sequence or inversion
156
   (spocq.i::make-property-path-verb :iri (or IRIRef |http://www.w3.org/1999/02/22-rdf-syntax-ns#|:|type|)))
157
 
158
 (defun |Verb-Constructor| (Path VarOrIRIref)
159
   (or Path VarOrIRIref |http://www.w3.org/1999/02/22-rdf-syntax-ns#|:|type|))
160
 
161
 
162
 #|
163
 ;;; to compile the parser state machine manually
164
 (load (compile-file #p"LIBRARY:org;datagraph;spocq;src;parser;sparql.lisp"))
165
 
166
 ;;; to translate the bnf into lisp
167
 ;;; requires the de.setf.atn-parser system
168
 (let ((bnfp:*class.atn* bnfp:*class.atn*)
169
       (bnfp:*class.atn-node* bnfp:*class.atn-node*)
170
       (bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)
171
       (bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)
172
       (bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)
173
       (bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))
174
   (bnfp:compile-atn-system  #p"P-LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-3.bnf"
175
                             :execute t :compile nil
176
                             :token-package :spocq.s
177
                             :source-package :sparql-1-0-3
178
                             :source-pathname "P-LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-3.lisp"
179
                             :input-function 'input-reference
180
                             :input-eof-function 'input-eof?
181
                             :ambiguous t        ; the property paths make it ambiguous
182
                             :trace nil))
183
 
184
 ;;; generate the grammar's atn definition
185
 (let ((bnfp:*class.atn* bnfp:*class.atn*)
186
       (bnfp:*class.atn-node* bnfp:*class.atn-node*)
187
       (bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)
188
       (bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)
189
       (bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)
190
       (bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))
191
   (atnp::print-atn-system #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-3.bnf"
192
                           :source-package (find-package :sparql-1-0-3)))
193
 
194
 (let ((bnfp:*class.atn* bnfp:*class.atn*)
195
       (bnfp:*class.atn-node* bnfp:*class.atn-node*)
196
       (bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)
197
       (bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)
198
       (bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)
199
       (bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))
200
   (atnp::graph-atn-system #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-3.bnf"
201
                           :source-package (find-package :sparql-1-0-3)))
202
                           
203
 
204
 |#