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

Kind	Covered	All	%
expression	211	355	59.4
branch	23	44	52.3

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-2; -*-

2

3

(in-package :org.datagraph.spocq.sparql-1-0-2)

4

5

6

;;; reduction operators

7

8

(defun |AddedMultiplicative-Constructor| (AdditiveOperator MultiplicativeExpression

9

                                           NumericLiteralNegative NumericLiteralPositive)

10

(cond (NumericLiteralPositive

11

(cons 'spocq.a:|+| NumericLiteralPositive))

12

(NumericLiteralNegative

13

(cons 'spocq.a:|-| (abs NumericLiteralNegative)))

14

(t

15

(cons AdditiveOperator MultiplicativeExpression))))

16

17

(defun |Bind-Constructor| (Expression Var)

18

;; return a tagged binding for later combination

19

`(:bind ,Var ,Expression))

20

21

(defun |BindingList-Constructor| (BindingValue*)

22

(reverse BindingValue*))

23

24

(defun |BindingValue-Constructor| (BooleanLiteral IRIref NumericLiteral RDFLiteral Undef)

25

(or BooleanLiteral IRIref NumericLiteral RDFLiteral :undef))

26

27

(defun |BindingsClause-Constructor| (BindingsList* Var*)

28

;; as per syntax-bindings-09, the short list is extended

29

(let ((var-count (length Var*)))

30

(flet ((extend-value-list (list)

31

(let ((value-count (length list)))

32

(cond ((= value-count var-count)

33

list)

34

((< value-count var-count)

35

                       (append list (make-list (- var-count value-count) :initial-element :undef)))

36

(t

37

(subseq list 0 value-count))))))

38

(declare (dynamic-extent #'extend-value-list))

39

(setf BindingsList* (mapcar #'extend-value-list BindingsList*))))

40

(list (reverse BindingsList*)

41

(reverse Var*)))

42

43

 (defun |BuiltInCall-Constructor| (BuiltinBinaryCall  BuiltinListCall  BuiltinNullCall BuiltinNullOrUnaryCall BuiltinUnaryCall

44

                                   ExistsFunc IfExpression NotExistsFunc RegexExpression SubstringExpression)

45

(or BuiltinNullCall BuiltinNullOrUnaryCall BuiltinBinaryCall BuiltinUnaryCall BuiltinListCall

46

ExistsFunc NotExistsFunc

47

RegexExpression IfExpression SubstringExpression))

48

49

(defun |BuiltinListCall-Constructor| (BuiltinListOperator ExpressionList)

50

(cons BuiltinListOperator ExpressionList))

51

52

(defun |BuiltinListOperator-Constructor| (item)

53

(if (eq (symbol-package item) *syntax-package*)

54

(or (find-builtin-operator item)

55

(error "Invalid list operator: '~a'." item))

56

item))

57

58

(defun |BuiltinNullCall-Constructor| (BuiltinNullOperator)

59

(list BuiltinNullOperator))

60

61

(defun |BuiltinNullOrUnaryCall-Constructor| (Expression? NullOrUnaryOperator)

62

(if Expression?

63

`(,NullOrUnaryOperator ,Expression?)

64

`(,NullOrUnaryOperator)))

65

66

(defun |ExpressionList-Constructor| (Expression* nillist)

67

(declare (ignore nillist))

68

(when Expression*

69

(reverse Expression*)))

70

71

(defun |ExistsFunc-Constructor| (GroupGraphPattern)

72

`(spocq.a:|exists| ,GroupGraphPattern))

73

74

(defun |GroupClause-Constructor| (GroupCondition+)

75

(list :group-by

76

(loop for condition in (reverse GroupCondition+)

77

collect (etypecase condition

78

(cons (list (if (variable-p (first condition))

79

(first condition)

80

(cons-variable "key-"))

81

(if (variable-p (first condition))

82

(second condition)

83

condition)))

84

(symbol condition)))))

85

86

(defun |GroupCondition-Constructor| (BuiltInCall FunctionCall VariableOrBindingOrExpression)

87

(or BuiltInCall FunctionCall VariableOrBindingOrExpression))

88

89

(defun |GroupGraphPattern-Constructor| (GroupGraphPatternSub SubSelect)

90

(or GroupGraphPatternSub SubSelect))

91

92

(defun |GroupGraphPatternRest-Constructor| (Bind Filter GraphPatternNotTriples TriplesBlock)

93

(list* (or Bind Filter GraphPatternNotTriples)

94

(when TriplesBlock (list TriplesBlock))))

95

96

(defun |GroupGraphPatternSub-Constructor| (GroupGraphPatternRest* TriplesBlock)

97

;; filter scope is the entire group, optional is left associated and

98

;; an optional treats a missing intial triple block as a unit table

99

(let ((unit '(spocq.a:|table| spocq.a:|unit|)))

100

(cond (GroupGraphPatternRest*

101

(let ((group TriplesBlock)

102

(filters ()))

103

(dolist (ggp-element (reverse GroupGraphPatternRest*))

104

(destructuring-bind (gpnt-or-filter triples-block) ggp-element

105

(case (first gpnt-or-filter)

106

(:bind

107

(destructuring-bind (var expression) (rest gpnt-or-filter)

108

(setf group `(spocq.a:|extend| ,group ,var ,expression))))

109

(:filter

110

(push (second gpnt-or-filter) filters))

111

(:optional

112

;; as per 6.1 the optional may have no predecessor

113

(let* ((optional-group (second gpnt-or-filter))

114

                            (optional-filter (when (eq (first optional-group) 'spocq.a:|filter|)

115

(third optional-group))))

116

(when optional-filter

117

(setf optional-group (second optional-group)))

118

(setf group

119

`(spocq.a:|leftjoin| ,(or group unit) ,optional-group

120

                                                  ,@(when optional-filter (list :test optional-filter))))))

121

(t

122

(setf group

123

(if group

124

`(spocq.a:|join| ,group ,gpnt-or-filter)

125

gpnt-or-filter))))

126

(when triples-block

127

(setf group

128

                          (if group `(spocq.a:|join| ,group ,triples-block) triples-block)))))

129

(if filters

130

`(spocq.a:|filter| ,(or group unit)

131

,(if (rest filters)

132

`(spocq.a:|exprlist| ,@(reverse filters))

133

(first filters)))

134

group)))

135

(TriplesBlock)

136

(t unit))))

137

138

(defun |HavingClause-Constructor| (HavingCondition+)

139

;; either reduce a singleton to the first constraint or wrap a sequence as a exprlist.

140

`(:having ,(if (rest HavingCondition+)

141

`(spocq.a:|exprlist| ,@(reverse HavingCondition+))

142

(first HavingCondition+))))

143

144

(defun |HavingCondition-Constructor| (Constraint)

145

Constraint)

146

147

(defun |IfExpression-Constructor| (Expression*)

148

`(spocq.a::|if| ,@(reverse Expression*)))

149

150

(defun |NotExistsFunc-Constructor| (GroupGraphPattern)

151

`(spocq.a:|!| ,(|ExistsFunc-Constructor| GroupGraphPattern)))

152

153

(defun |NullOperator-Constructor| (item)

154

(if (eq (symbol-package item) *syntax-package*)

155

(or (find-builtin-operator item)

156

(error "Invalid null operator: '~a'." item))

157

item))

158

159

(defun |NullOrUnaryOperator-Constructor| (item)

160

(if (eq (symbol-package item) *syntax-package*)

161

(or (find-builtin-operator item)

162

(error "Invalid null operator: '~a'." item))

163

item))

164

165

(defun |Query-Constructor| (AskQuery BindingsClause? ConstructQuery DescribeQuery Prologue SelectQuery)

166

   ;; 1.1 added an optional bindings clause. the CR moved it from the select production to the query construction

167

   ;; evidently with the intent to have it act in the position of a solution modifier for all query forms.

168

;; on bindings :

169

;; http://lists.w3.org/Archives/Public/public-rdf-dawg/2010JulSep/0370.html

170

;; http://lists.w3.org/Archives/Public/public-rdf-dawg/2011JanMar/0005.html

171

(declare (ignore Prologue))

172

(let ((base-clause (or AskQuery ConstructQuery DescribeQuery SelectQuery)))

173

(if BindingsClause?

174

(destructuring-bind (operator solution-field &rest rest)

175

base-clause

176

`(,operator (spocq.a:|join| (spocq.a:|bindings| ,@BindingsClause?) ,solution-field) ,@rest))

177

base-clause)))

178

179

180

(defun |SelectClause-Constructor| (Distinctness VarIableOrBinding* Wild)

181

`(:Distinctness ,Distinctness :VarIableOrBinding* ,VarIableOrBinding* :Wild ,Wild))

182

183

(defun |SelectQuery-Constructor| (DatasetClause* SelectClause SolutionModifier WhereClause)

184

(construct-select :SelectClause SelectClause

185

:DatasetClause* DatasetClause*

186

:WhereClause WhereClause

187

:SolutionModifier SolutionModifier))

188

189

(defun construct-select (&key SelectClause DatasetClause* WhereClause SolutionModifier)

190

;; on the meaning of a having w/o a group,

191

;; http://lists.w3.org/Archives/Public/public-rdf-dawg-comments/2010Jan/0005.html

192

;; says that, without the grouping, the entire field is treated as a single group

193

194

(update-dataset-graphs DatasetClause* :query)

195

(destructuring-bind (&key (Distinctness nil) (VarIableOrBinding* nil) (wild nil))

196

SelectClause

197

(destructuring-bind (&key limit offset order group-by having)

198

SolutionModifier

199

(let* ((where-dimensions (spocq.i::expression-dimensions WhereClause))

200

(selection-specification (cond (Wild

201

(cond (group-by

202

                                                     (mapcar #'(lambda (spec)

203

                                                                 (if (consp spec) (first spec) spec))

204

                                                             group-by))

205

                                                    ((and (bgp-form-p WhereClause)

206

                                                          (triple-form-p (second WhereClause))

207

                                                          (null (cddr WhereClause)))

208

                                                     (remove-if-not #'spocq.i::distinguished-variable-p (rest (second WhereClause))))

209

(t

210

                                                     ;; fails for subselect (reverse *variables*)

211

                                                     (remove-if-not #'spocq.i::distinguished-variable-p

212

                                                                    where-dimensions))))

213

(VarIableOrBinding*

214

                                              (reverse VarIableOrBinding*))

215

(t

216

                                              (error "Either VariableOrBinding or Wild is required."))))

217

(elementary-select? nil)

218

               ;; split the order form into those clauses which suffice with the dimensionality of the

219

              ;; base where clause and the rest. place the first set in an initial wrapper and save the

220

;; rest to apply to the projection result

221

(where-order (loop for clause in order

222

                                 for clause-dimensions = (spocq.i::expression-dimensions clause)

223

                                 if (null (set-difference clause-dimensions where-dimensions))

224

collect clause))

225

(projected-order (loop for clause in order

226

unless (member clause where-order)

227

collect clause))

228

(result-form nil))

229

(declare (ignore projected-order))

230

(flet ((is-duplicate-binding (binding bindings)

231

(when (consp binding)

232

(let ((variable (first binding)))

233

(dolist (binding bindings)

234

(typecase binding

235

(cons (when (eq variable (first binding)) (return t)))

236

(t (when (eq variable binding) (return t)))))))))

237

;; the group clause may establish bindings for the selection projection,

238

;; but the variables must be unique in the projection itself

239

(loop for (binding . rest) on selection-specification

240

do (assert (not (is-duplicate-binding binding rest)) ()

241

"Duplicate bindings: ~a . ~a" binding rest)))

242

243

;; (when where-order (setf WhereClause `(spocq.a:|order| ,WhereClause ,where-order)))

244

(when group-by

245

(setf selection-specification (list* :group-by group-by selection-specification)))

246

(when having

247

(setf selection-specification (list* :having having selection-specification)))

248

(if (setf elementary-select? (every #'spocq.i::variable-p selection-specification))

249

(setf result-form WhereClause)

250

(setf result-form `(spocq.a:|select| ,WhereClause ,selection-specification)))

251

;; (when projected-order (setf result-form `(spocq.a:|order| ,result-form ,projected-order)))

252

(when order (setf result-form `(spocq.a:|order| ,result-form ,order)))

253

(when elementary-select?

254

(setf result-form `(spocq.a:|select| ,result-form ,selection-specification)))

255

(when Distinctness

256

(setf result-form `(,Distinctness ,result-form)))

257

(when (or limit offset)

258

(setf result-form `(spocq.a:|slice| ,result-form

259

                                               ,@(when offset `(:offset ,offset))

260

                                               ,@(when limit `(:count ,limit)))))

261

262

result-form))))

263

264

(defun |SolutionModifier-Constructor| (GroupClause? HavingClause? OrderClause? LimitOffsetClauses?)

265

(append GroupClause? HavingClause? OrderClause? LimitOffsetClauses?))

266

267

(defun |SubSelect-Constructor| (SelectClause SolutionModifier WhereClause)

268

(construct-select :SelectClause SelectClause

269

:SolutionModifier SolutionModifier

270

:WhereClause WhereClause))

271

272

(defun |SubstringExpression-Constructor| (Expression*)

273

`(spocq.a::|substr| ,@(reverse Expression*)))

274

275

(defun |Undef-Constructor| (item)

276

item)

277

278

(defun |VariableOrBindingOrExpression-Constructor| (Expression Var)

279

(if Expression

280

(if Var

281

`(,Var ,Expression)

282

Expression)

283

Var))

284

285

#|

286

;;; to compile the parser state machine manually

287

(load (compile-file #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql.lisp"))

288

289

;;; to translate the bnf into lisp

290

(asdf:load-system :de.setf.atn-parser system)

291

(asdf:load-system :de.setf.utility.codecs)

292

(load #p"P-LIBRARY:org;datagraph;spocq;src;core;package.lisp")

293

294

(let ((bnfp:*class.atn* bnfp:*class.atn*)

295

(bnfp:*class.atn-node* bnfp:*class.atn-node*)

296

(bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)

297

(bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)

298

(bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)

299

(bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))

300

(bnfp:compile-atn-system #p"P-LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-2.bnf"

301

:execute t :compile nil

302

:token-package (find-package :spocq.s)

303

:source-package (find-package :sparql-1-0-2)

304

                             :source-pathname "P-LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-2.lisp"

305

:input-function 'input-reference

306

:input-eof-function 'input-eof?

307

:ambiguous t

308

:trace nil))

309

310

;;; generate the grammar's atn definition

311

(let ((bnfp:*class.atn* bnfp:*class.atn*)

312

(bnfp:*class.atn-node* bnfp:*class.atn-node*)

313

(bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)

314

(bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)

315

(bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)

316

(bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))

317

(atnp::print-atn-system #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-2.bnf"

318

:source-package (find-package :sparql-1-0-2)))

319

320

(let ((bnfp:*class.atn* bnfp:*class.atn*)

321

(bnfp:*class.atn-node* bnfp:*class.atn-node*)

322

(bnfp:*class.cat-atn-edge* bnfp:*class.cat-atn-edge*)

323

(bnfp:*class.pop-atn-edge* bnfp:*class.pop-atn-edge*)

324

(bnfp:*class.push-atn-edge* bnfp:*class.push-atn-edge*)

325

(bnfp:*class.test-atn-edge* bnfp:*class.test-atn-edge*))

326

(atnp::graph-atn-system #p"LIBRARY:org;datagraph;spocq;src;core;encoding;sparql-1-0-2.bnf"

327

:source-package (find-package :sparql-1-0-2)))

328

329

330

|#