Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rdfcache/logical-bgp.lisp

Kind	Covered	All	%
expression	0	637	0.0
branch	0	64	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

6

 (:documentation "The 'logical' basic graph pattern (bgp) form augments the conjunctive join semantics for a SPARQL bgp

7

with disjunctive combinations. It permits internal operators

8

9

- spocq.a:|and| : indicates a conjuction among its constituents. in this case,

10

all respective solutions must be compatible.

11

- spocq.a:|or| : indicates a disjunction among its constituents. in this case,

12

the first statement solution is the solution for the entire form.

13

- spocq.a:|sum| : indicates a contingent combination of constituents. in this case,

14

the solutions for the variables common to among patterns must be compatible - as

15

for a conjunction, but only one is required and all are collected.

16

17

  The logic is implemented by varying the effect of each of the respective continuations for a given pattern match

18

The options success/failure options are

19

20

success \ failure bgp-succeeds successor bgp-fails

21

bgp-succeeds --- or ---

22

successor --- those and

23

bgp-fails not --- ---

24

25

In which the successor action will vary for the distinct modes:

26

27

or : if no triple pattern succeeds, then the bgp fails

28

sum : if any triple pattern has succeeded, then the bgp succeeds

29

and : if all patterns have succeeded, then the bgp succeeds

30

not : does not apply

31

32

  The consequence is that, in addition to the mode in which the all statements in a conjuctive pattern must

33

  yield consistent matches against a dataset graph in order for the bgp to yield a solution set, only one

34

  statement in a disjunctive pattern must succeed and any of the statements in a contingent pattern may

35

  succeed. When the purpose of a contingent form is to consolidate chained optional clauses, it applies when

36

  the subjects, are consistent - either as compatible variable bindings or identical constants. Instead of

37

  requiring each match to succeed, each statement pattern can either iterate over the solutions provided by

38

  next, or, where no solution exists, it continues to the successor anyway, with the variables bound to the

39

null term. where any statement pattern succeeds, it generates a new solution in the result field.")

40

41

42

(defparameter *bgp-cursors* ())

43

44

(defparameter *spocq.i* (find-package :spocq.i))

45

46

(defun next-cursor ()

47

(let ((var (cons-symbol *spocq.i* :cursor- (princ-to-string (next-variable-index)))))

48

(push var *bgp-cursors*)

49

var))

50

51

(defun next-continuation-name ()

52

(cons-symbol *spocq.i* :op- (princ-to-string (next-variable-index))))

53

54

(defun next-succeed-continuation-name (&optional (prefix :op-succeed-))

55

(cons-symbol *spocq.i* prefix (princ-to-string (next-variable-index))))

56

(defun next-fail-continuation-name (&optional (prefix :op-fail-))

57

(cons-symbol *spocq.i* prefix (princ-to-string (next-variable-index))))

58

59

(defun next-succeed-name ()

60

(cons-symbol *spocq.i* :succeed- (princ-to-string (next-variable-index))))

61

62

63

(defun translate-bgp-form (bgp-pattern succeed-continuation fail-continuation &rest options)

64

(declare (dynamic-extent options))

65

   (apply #'translate-bgp-forms (first bgp-pattern) succeed-continuation fail-continuation (rest bgp-pattern) options))

66

67

(defun cursor-reader (position)

68

(ecase position

69

(:context 'rdfcache:cursor-context-number)

70

(:subject 'rdfcache:cursor-subject-number)

71

(:predicate 'rdfcache:cursor-predicate-number)

72

(:object 'rdfcache:cursor-object-number)))

73

74

(defmacro extract-terms (cursor &rest specs)

75

`(progn ,@(loop for (variable position) in specs

76

for operator = (cursor-reader position)

77

collect `(setf ,variable (,operator ,cursor)))))

78

79

(defgeneric translate-bgp-forms (operator succeed-continuation fail-continuation forms &rest options)

80

81

(:documentation "

82

each compound form is compiled by recursing with the current continuations.

83

each operator can vary the continuations

84

- and : leaves them unchainged

85

- or : success is the same, such that any match completes the compound

86

         fail for each subform is the next subform; requires a tag-body with a new tag before each sub-form

87

  - sum : success and fail both continue to the next form based on tags; success also notes the ultimate success

88

    the phrase completion continues with the outer success if any subform succeeded otherwise with the outer fail

89

- not : reverse the success and fail continuations

90

91

Each match follows one of two continuations, depending on whether it succeeds or fails. Each of the

92

  combination forms sonstructs the appropriate control flow among the matches to accomplish it logical result.

93

    - and : success augments the solution bindings and continues with the next statement. failure terminates

94

      the clause. a clause which completes with a match for all quads adds the collected solution set to the

95

result field

96

    - or : success augments the solution bindings and completes the clause. failure continues with the next

97

      statement in the clause. if the clause completed with a match, the solution setf from that match

98

to the result field.

99

    - sum : success augments the solution bindings and continues with the next statement. failure continues

100

      with the next statement. if the clause completes with any match, the accumulated solution set is added

101

to the result field.

102

    - not (wraps some other caluse) : if the clause succeeds, proceeds with the failure continuation from the

103

      containing clause. the inverse applies to success: it proceeds with a 'unit' solution, but does not add

104

any bindings of its own.

105

- union : accumulate all mathced solutions.")

106

107

   (:method ((operator (eql 'spocq.a:|and|)) succeed-continuation fail-continuation forms &rest options &key bound-variables &allow-other-keys)

108

(declare (dynamic-extent options))

109

(let* ((form-variables (expression-variables forms))

110

(local-variables (set-difference form-variables bound-variables))

111

(continuation-names (loop for nil in forms collect (next-continuation-name)))

112

(form-lambdas (loop for form in forms

113

                                      for continuation-name in (append (rest continuation-names) (list succeed-continuation))

114

                                      collect (apply #'translate-bgp-form form continuation-name fail-continuation ; would fail for first only (shiftf fail-continuation nil)

115

                                                     :bound-variables (shiftf bound-variables (union bound-variables (expression-variables form)))

116

options))))

117

`(lambda ()

118

(setf ,@(loop for var in local-variables append `(,var 0)))

119

(labels ,(loop for lambda in form-lambdas

120

for name in continuation-names

121

collect `(,name ,@(rest lambda)))

122

(,(first continuation-names))))))

123

124

   (:method ((operator (eql 'spocq.a:|filter|)) succeed-continuation fail-continuation forms &key &allow-other-keys)

125

(let* ((test-expression (first forms))

126

(test-variables (expression-variables test-expression))

127

(test-expression `(handler-case (ebv ,test-expression) (error () nil))))

128

`(lambda ()

129

,(if test-variables

130

             (let ((test-aliases (loop for variable in test-variables collect (make-symbol (symbol-name variable)))))

131

`(if ((lambda ,test-aliases

132

(symbol-macrolet ,(loop for variable in test-variables

133

                                               for alias in test-aliases

134

                                               collect `(,variable (term-number-object ,alias)))

135

                         (trace-bgp logical-bgp-match.filter ',test-expression ',test-variables (list ,@test-aliases) (list ,@test-variables))

136

,test-expression))

137

,@test-variables)

138

(,succeed-continuation)

139

,@(when fail-continuation `((,fail-continuation)))))

140

`(if ,test-expression

141

(,succeed-continuation)

142

,@(when fail-continuation `((,fail-continuation))))))))

143

144

   (:method ((operator (eql 'spocq.a:|or|)) succeed-continuation fail-continuation forms &rest options &key bound-variables &allow-other-keys)

145

(let* ((form-variables (expression-variables forms))

146

(local-variables (set-difference form-variables bound-variables))

147

(continuation-names (loop for i below (length forms) collect (next-continuation-name)))

148

(form-lambdas (loop for form in forms

149

                                      for continuation-name in (append (rest continuation-names) (list fail-continuation))

150

                                      collect (apply #'translate-bgp-form form succeed-continuation continuation-name

151

                                                     :bound-variables bound-variables

152

options))))

153

`(lambda ()

154

(setf ,@(loop for var in local-variables append `(,var 0)))

155

(labels ,(loop for lambda in form-lambdas

156

for name in continuation-names

157

collect `(,name ,@(rest lambda)))

158

(,(first continuation-names))))))

159

160

(:method ((operator (eql 'spocq.a:|not|)) succeed-continuation fail-continuation forms &rest options)

161

(declare (dynamic-extent options))

162

(assert (null (rest forms)) ()

163

"Invalid negation-pattern : ~a." (cons operator forms))

164

(apply #'translate-bgp-form (first forms) fail-continuation succeed-continuation options))

165

166

(:method ((operator (eql 'spocq.a:|quad|)) succeed-continuation fail-continuation c-s-p-o

167

             &key (offset nil) (bound-variables '()) (wildcard-term (error "wildcard-term is required.")) (transaction '*transaction*)

168

(match-result-count 'match-result-count) (match-request-count 'match-request-count)

169

(force-extract-p nil))

170

(let* ((cursor (next-cursor))

171

(statement-variables (expression-variables c-s-p-o))

172

(local-variables (set-difference statement-variables bound-variables))

173

(match-pattern (loop for term in c-s-p-o

174

                                 collect (if (member term local-variables) wildcard-term term)))

175

(match-result (loop for term in c-s-p-o

176

collect (if (or (member term local-variables)

177

                                                (and force-extract-p (member term statement-variables)))

178

term (gensym "constant"))))

179

(uniqued-result (loop for vars on match-result

180

for v in match-result

181

                                  collect (if (member v (rest vars)) (gensym "duplicate") v)))

182

(constrain-duplicates? (not (equal uniqued-result match-result))))

183

184

;; (print c-s-p-o) (print match-pattern) (terpri )

185

186

(cond ((property-path-p (third c-s-p-o))

187

(let* ((path-continuation (gensym "PATH-CONTINUATION"))

188

(ignored-variables (remove-if #'symbol-package uniqued-result)))

189

`(lambda (&aux (succeeded nil))

190

(trace-bgp logical-bgp-match.pp-to-match ',c-s-p-o)

191

                   ;; property paths do not count requests/results at this level, as a single path expands into

192

;; many internal requests and results

193

(labels ((,path-continuation (,@uniqued-result)

194

                              ,@(when ignored-variables `((declare (ignorable ,@ignored-variables))))

195

(trace-bgp logical-bgp-match.pp-matched ,@uniqued-result)

196

                              (,@(if (and offset (eq succeed-continuation 'collect-solution))

197

                                   ;; an innermost loop skips past the solution offset

198

`(when (minusp (decf ,offset)))

199

`(progn))

200

;; constrain aliased variables

201

(,@(if constrain-duplicates?

202

`(when (and ,@(loop for v in match-result

203

                                                        for u in uniqued-result

204

                                                        unless (eq u v)

205

                                                        collect `(= ,u ,v))))

206

`(progn))

207

(setf succeeded t)

208

(,succeed-continuation)))))

209

(declare (dynamic-extent #',path-continuation))

210

(match-property-path ,transaction ,@match-pattern #',path-continuation)

211

,@(when fail-continuation

212

`((unless succeeded (,fail-continuation))))))))

213

((extension-operator-p (third c-s-p-o))

214

(let* ((extension-continuation (gensym "EXTENSION-CONTINUATION"))

215

(ignored-variables (remove-if #'symbol-package uniqued-result)))

216

`(lambda (&aux (succeeded nil))

217

(trace-bgp logical-bgp-match.extension ',c-s-p-o)

218

                   ;; extensions do not count requests/results at this level, as a single operation may expand into

219

;; many internal requests and results

220

(labels ((,extension-continuation (,@uniqued-result)

221

                              ,@(when ignored-variables `((declare (ignorable ,@ignored-variables))))

222

                              (trace-bgp logical-bgp-match.extension-matched ,@uniqued-result)

223

                              (,@(if (and offset (eq succeed-continuation 'collect-solution))

224

                                   ;; an innermost loop skips past the solution offset

225

`(when (minusp (decf ,offset)))

226

`(progn))

227

;; constrain aliased variables

228

(,@(if constrain-duplicates?

229

`(when (and ,@(loop for v in match-result

230

                                                        for u in uniqued-result

231

                                                        unless (eq u v)

232

                                                        collect `(= ,u ,v))))

233

`(progn))

234

(setf succeeded t)

235

(,succeed-continuation)))))

236

(declare (dynamic-extent #',extension-continuation))

237

(funcall-extension ,transaction ,@match-pattern #',extension-continuation)

238

,@(when fail-continuation

239

`((unless succeeded (,fail-continuation))))))))

240

(t

241

`(lambda (,@(when constrain-duplicates? '(&aux (succeeded nil))))

242

(trace-bgp logical-bgp-match.cspo-to-match ',c-s-p-o)

243

,@(when match-request-count `((incf ,match-request-count)))

244

                 (cond ((and (plusp (rdfcache-match (transaction-record ,transaction) ,cursor ,@match-pattern))

245

                             ,@(when (and offset (eq succeed-continuation 'collect-solution))

246

                                 ;; an innermost loop skips past the solution offset

247

`((not (and (plusp ,offset)

248

                                             (plusp (decf ,offset (rdfcache:skip ,cursor ,offset))))))))

249

                        (rdfcache-declare-terms ,cursor ,@(loop for argument in match-pattern

250

                                                                collect (if (or (eql argument wildcard-term)

251

                                                                                (and force-extract-p (member argument statement-variables)))

252

                                                                          :term-number nil)))

253

(loop

254

(unless (rdfcache-next ,cursor) (return))

255

,@(when match-result-count `((incf ,match-result-count)))

256

,(if constrain-duplicates?

257

;; constrain aliased variables

258

                             `(symbol-macrolet ,(loop for unique-term in uniqued-result

259

                                                      for term in match-result

260

                                                      for position in '(:context :subject :predicate :object)

261

                                                      unless (eq unique-term term)

262

                                                      collect `(,unique-term (,(cursor-reader position) ,cursor)))

263

                                (extract-terms ,cursor ,@(loop for term in match-result

264

                                                               for position in '(:context :subject :predicate :object)

265

                                                               when (member term local-variables)

266

                                                               collect (list term position)))

267

                                (when (and ,@(loop for unique-term in uniqued-result

268

                                                   for term in match-result

269

                                                   unless (eq unique-term term)

270

                                                   collect `(= ,unique-term ,term)))

271

(setf succeeded t)

272

(,succeed-continuation)))

273

`(progn

274

                                (extract-terms ,cursor ,@(loop for term in match-result

275

                                                               for position in '(:context :subject :predicate :object)

276

                                                               when (or (member term local-variables)

277

                                                                        (and force-extract-p (member term statement-variables)))

278

                                                               collect (list term position)))

279

(,succeed-continuation))))

280

,@(when (and constrain-duplicates? fail-continuation)

281

`((unless succeeded (,fail-continuation)))))

282

,@(when fail-continuation

283

`((t

284

(,fail-continuation))))))))))

285

;; two errors:

286

;; 1. when a successful initial match has completed, the next clause must restart with

287

;; shared terms as wildcards as well. this must somehow suppress the original solution

288

   ;; 2. failures must clear non-shared terms in order that they not carry over from a preious success cycle.

289

(:method ((operator (eql 'spocq.a:|sum|)) succeed-continuation fail-continuation forms &rest options

290

             &key bound-variables (wildcard-term (error "wildcard-term is required.")) &allow-other-keys)

291

(declare (dynamic-extent options))

292

(let* ((form-variables (expression-variables forms))

293

(local-variables (set-difference form-variables bound-variables))

294

(shared-local-variables (reduce #'intersection forms :key #'expression-variables))

295

(bound-variables (union shared-local-variables bound-variables))

296

(continuation-names (loop for i below (length forms) collect (next-continuation-name)))

297

(succeed-sum (next-succeed-name))

298

(form-lambdas (loop for form in forms

299

                                      for continuation-name in (append (rest continuation-names) `(,succeed-sum))

300

                                      collect (apply #'translate-bgp-form form continuation-name continuation-name

301

                                                     ;; leave the bound variable unmodified, as a failures 'succeeds' also

302

                                                     :bound-variables bound-variables

303

                                                     :force-extract-p t

304

options))))

305

`(lambda ()

306

(setf ,@(loop for var in local-variables append `(,var ,wildcard-term)))

307

(labels ((,succeed-sum ()

308

                   (if (or ,@(loop for var in local-variables collect `(not (eql ,var ,wildcard-term))))

309

(,succeed-continuation)

310

,@(when fail-continuation

311

`((,fail-continuation)))))

312

,@(loop for lambda in form-lambdas

313

for name in continuation-names

314

collect `(,name ,@(rest lambda))))

315

(,(first continuation-names))))))

316

317

   (:method ((operator (eql 'spocq.a:|union|)) succeed-continuation fail-continuation forms &rest options &key bound-variables &allow-other-keys)

318

;; collect the sulutions from all alternatives

319

(let* ((form-variables (expression-variables forms))

320

(local-variables (set-difference form-variables bound-variables))

321

(continuation-names (loop for i below (length forms) collect (next-continuation-name)))

322

(form-lambdas (loop for form in forms

323

                                      for continuation-name in (append (rest continuation-names) (list fail-continuation))

324

collect (apply #'translate-bgp-form form

325

`(lambda ()

326

                                                        (,succeed-continuation)

327

                                                        (,continuation-name))

328

                                                     continuation-name

329

                                                     :bound-variables bound-variables

330

options))))

331

`(lambda ()

332

(setf ,@(loop for var in local-variables append `(,var 0)))

333

(labels ,(loop for lambda in form-lambdas

334

for name in continuation-names

335

collect `(,name ,@(rest lambda)))

336

(,(first continuation-names))))))

337

)

338

339

340

341

(defmethod compute-logical-bgp-lambda ((agp-repository rdfcache-id-repository) body &key

342

                                        (base-dimensions ())          ; initial solution field variables

343

                                        (projection-dimensions (expression-dimensions body))

344

                                        (wildcard-term (repository-wildcard-term agp-repository))

345

                                        (default-context-term (repository-default-context-term agp-repository))

346

                                        (named-contexts-term (repository-named-contexts-term agp-repository))

347

                                        graph    ; if in a graph clause, then either a variable or a literal

348

(dataset-graphs nil)

349

                                        (named-graphs (dataset-named-graphs dataset-graphs))

350

                                        (default-graphs (dataset-default-graphs dataset-graphs))

351

                                        (graphs (cond ((null graph)       default-graphs)

352

                                                      ((variable-p graph) named-graphs)

353

                                                      ((typep graph 'iri) (list graph))

354

(t

355

                                                       (error "Invalid dataset specification: graph ~s, default ~s, named ~s."

356

                                                              graph default-graphs named-graphs))))

357

(transaction *transaction*)

358

(trace *compute-bgp-lambda.trace*)

359

(dynamic-variables ()))

360

   "Generate a matching operator from a BGP for the rdfcache store. The implementation combines several things:

361

362

- it combines a graph specification with the elementary triples to perform yield quad matches

363

- it integrates out-of-line path matching with in-line quad matching

364

   - it matches elementary quad patterns and captures the bindings initially in the lexical environment and

365

ultimately in a result solution field

366

- it arranges a control flow among individual and group matching operations to accomplish the logic

367

implicit in and/or/those/not clauses

368

   - where an initial field is provided, it establishes each solution in turn as the initial bindings for an

369

iteration

370

371

  The graph matching requirements are described in graph.lisp. The bgp-to-be-compiled has captures the query

372

specification as follows:

373

374

    - The graph argument is taken from the agp's respective field. Where the bgp was in the scope of a graph

375

clause, that graph term was noted by the macro-expansion for spocq.a:|graph|.

376

Otherwise, that is, for an autonomous basic graph pattern, there is no graph term.

377

    - the default-graphs and named-graphs arguments are taken from the agp's respective fields. These values

378

      either are either those specified in the query document's preamble, in the request headers, or directly

379

380

381

  The graph argument can be either a variable or a constant. If it is a variable, the bgp applies to named

382

graphs:

383

- if named-graphs is non-null, the match maps the variable over that set, while

384

    - if named-graphs is null, no constraint is applied to the graph variable and it ranges over the values

385

for the context term in match/next results for a wildcard context.

386

If graph is a literal, a variable is introduced, bound to that value at the outset.

387

If graph is null, the bgp applies to 'default' graphs:

388

    - If default-graphs is non-null, a variable is introduced and the match maps it over that set, while

389

    - if default-graphs is null, a variable is introduced, bound to the repository's default graph designator.

390

391

  The kernel of the bgp match is a single iterator which starts with a quad match or a path match for which

392

  each term is either a term number which refers to a constant constant value either from the original triple

393

  or graph form, as bound by a term from a preceeding quad match, or it is a wild card intended to yield

394

bindings for the current statement.

395

396

397

"

398

399

400

;; until dimension declaration is complete

401

;; for a logical bgp, permit undistinguished variables in order to collect them

402

(setf projection-dimensions (expression-dimensions body))

403

404

(let* (;; if the query had a literal graph term, provide a variable

405

(graph-variable (if (variable-p graph) graph 'graph))

406

;; note if the graph variable is among the initial solutions

407

(initial-solution-graph-variable (find graph base-dimensions))

408

;; indicate whether the graph needs to be set on first query

409

;; (set-graph-variable (and (variable-p graph) (not initial-solution-graph-variable)))

410

          ;; extract just the expressions wto be included in the matching and bindings propagation code

411

(iteration-patterns (remove-if-not #'bgp-pattern-form-p body))

412

(id (second (assoc 'spocq.a::|id| body)))

413

;; extract and consolidate anu declaration clauses

414

          (declarations (reduce #'append (mapcar #'rest (remove 'spocq.a::|declare| body :test-not #'eq :key #'first))))

415

          ;; get the a-list of variables which were inferred to be related through a sameTerm filter constraint

416

;; in order to mirror any binding/setting

417

(equivalents (rest (assoc 'spocq.a::|equivalents| body)))

418

          ;;!!! still builds state for triples with paths even though cursors and terms are handled out-of-line

419

;; adjust bounds to account for per-thread cursors

420

(slice-offset (second (assoc 'spocq.a:|slice| body)))

421

(slice-count (third (assoc 'spocq.a:|slice| body)))

422

(projection-variable-count (length projection-dimensions))

423

(equivalent-variables (mapcar #'first equivalents))

424

(collection-variables (difference-dimensions projection-dimensions equivalent-variables))

425

(blank-nodes (expression-blank-nodes iteration-patterns))

426

(blank-node-map (loop for node in blank-nodes collect (cons node (cons-variable))))

427

(property-paths ())

428

          ;; the interface operator accepts the repository, and optionally an initial spo solution field, and/or a graph sequence

429

          ;; this wraps an operator which iterates outer over the spo field to bind the starting values for those variables

430

          ;; for each pass and then iterates secondarily over the graph field to perform the pattern matches.

431

;;

432

          ;; the top-level match form starts with all patterns, _no_ bound variables, and the cursor lists

433

          ;; corresponding to the patterns. not even the solution variables are bound initially, as they may themselves

434

;; start out as wild cards.

435

(initial-bindings (append (if (or graphs (not graph))

436

                                      (union-dimensions (list graph-variable) base-dimensions)

437

base-dimensions)

438

dynamic-variables))

439

(default-context-term-number (repository-object-term-number agp-repository default-context-term))

440

(named-contexts-term-number (repository-object-term-number agp-repository named-contexts-term)))

441

442

(declare (ignore declarations))

443

(labels ((intern-if-constant (object)

444

(cond ((variable-p object)

445

object)

446

((spocq:blank-node-p object)

447

(or (rest (assoc object blank-node-map))

448

(error "lost a blank-node: ~a" object)))

449

((property-path-p object)

450

(push object property-paths)

451

(repository-intern-property-path transaction object))

452

(t

453

(rdfcache-object-term-number transaction object))))

454

(intern-form (form)

455

(typecase form

456

(cons (destructuring-bind (op . rest) form

457

(ecase op

458

                            (spocq.a:|triple| (list* 'spocq.a:|quad| graph-variable (mapcar #'intern-if-constant rest)))

459

(spocq.a:|filter| form)

460

                            ((spocq.a:|and| spocq.a:|not| spocq.a:|or| spocq.a:|sum| spocq.a:|union|)

461

                             (cons op (loop for form in rest collect (intern-form form)))))))

462

(t (intern-if-constant form)))))

463

;; allow for just the graph as a variable for literal bgp patterns?

464

(if (variable-p graph)

465

(setf projection-dimensions (union-dimensions (list graph) projection-dimensions))

466

(when graph (setf graph (intern-if-constant graph))))

467

;; reconstuct the statements patterns in the bgp patter into a single logical combination

468

;; in which any constants have been interned and any triples ahve been rewritte into quads

469

(setf iteration-patterns

470

(if (cdr iteration-patterns)

471

(cons 'spocq.a:|and| iteration-patterns)

472

(first iteration-patterns)))

473

(setf iteration-patterns (map-tree #'intern-form iteration-patterns))

474

(when trace (print (cons :iteration-patterns iteration-patterns)))

475

476

(setf graphs (mapcar #'intern-if-constant graphs))

477

(setf default-graphs (mapcar #'intern-if-constant default-graphs))

478

(setf named-graphs (mapcar #'intern-if-constant named-graphs))

479

       (setf equivalents (loop for (var . value-or-var) in equivalents collect (cons var (intern-if-constant value-or-var))))

480

481

(when trace

482

         (format *trace-output* "~&*compute-bgp-lambda.trace*~%body ~s~%graph ~s~%named ~s~%default ~s~%graphs ~s~%initial-solution-graph-variable ~s~%graph-variable ~s"

483

                 body graph named-graphs default-graphs graphs initial-solution-graph-variable graph-variable))

484

485

         ;; the actual query operator takes one of two forms. iff base dimensions are included, it is

486

         ;; generated to expect a solution field source, and to iterate the entire operator over the field's solutions.

487

;; without base dimensions, it runs autonomously.

488

         ;; the combination makes it possible to construct query processing both as reduction through bottom-up combination

489

;; and as solution combination, and even as some combination of the two

490

         ;; where evaluation materialized all intermediate solutions, it did not matter that the reduction order agree

491

         ;; with the matching order. the intermediate matching results were cached for delayed use as combination arguments.

492

         ;; where the solution data flows form one operator tot he next, with the intent to limit the space required for

493

         ;; intermediate fields by streaming results, the contradictory evaluation order would still require buffered

494

;; materialization. for example an expression of the form

495

;;

496

;; (join (?a ?b ?c) (join (?b ?c) (?c)))

497

;;

498

;; would reduce with data flow

499

;;

500

;; ((?b ?c) . (?c) . (?a ?b ?c))

501

;;

502

;; but match with data flow

503

;; (?c) -> (?b ?c) -> (?a ?b ?c)

504

;;

505

;; which entail inverted match orders. the question is, how to enable both?

506

507

(let* ((*bgp-cursors* ())

508

(*task-indices* (make-task-indices))

509

                (form-lambda (translate-bgp-form iteration-patterns 'collect-solution 'complete-graph-solutions

510

                                                 :bound-variables initial-bindings

511

                                                 :wildcard-term wildcard-term

512

:offset slice-offset

513

                                                 :transaction '*transaction*))

514

(query-lambda

515

`(lambda (bgp-continuation ,@(when base-dimensions '(source)))

516

;; (declare (optimize ,@*field-optimization*))

517

(declare (optimize (SPEED 0) (SAFETY 3)))

518

(assert-argument-types logical-bgp-match

519

(bgp-continuation (or channel function))

520

,@(when base-dimensions '((source (or channel function)))))

521

(let* ((repository *repository*)

522

(repository-id (repository-revision-id repository))

523

                          (*thread-operations* (cons (list 'spocq.a:|bgp| ',body) *thread-operations*))

524

(match-request-count 0)

525

(match-result-count 0)

526

,@(when slice-offset `((solution-offset ,slice-offset)))

527

,@(when slice-count `((solution-count ,slice-count)))

528

(result-page nil)

529

(result-page-length *field-page-length*)

530

(result-index *field-page-length*)

531

(result-count 0)

532

(*wildcard-identifier* ,wildcard-term)

533

(*default-context-identifier* ,default-context-term-number))

534

                     ; if the pattern predicates are all paths, the processing is out-of-line

535

(declare (ignorable repository-id))

536

,@(when dynamic-variables

537

`((declare (special ,@dynamic-variables))))

538

; establish global bindings for all eventual solution variables

539

(let (,@(loop for variable in collection-variables

540

unless (member variable base-dimensions)

541

collect `(,variable 0))

542

,@(loop for (nil . variable) in blank-node-map

543

collect `(,variable 0)))

544

(block :logical-bgp-match

545

(labels ((coerce-to-term-id (term-number)

546

(typecase term-number

547

(fixnum term-number)

548

                                     (t (warn "result not a term number: ~s." term-number)

549

0)))

550

(collect-solution-variables ,collection-variables

551

,@(when slice-count

552

                                     `((when (minusp (decf solution-count)) (complete-solutions))))

553

                                 (trace-bgp logical-bgp-match.collect-solution ,@collection-variables)

554

(incf result-count)

555

,(if projection-dimensions

556

                                    `(let ,(loop for (alias . equivalent) in equivalents         ; bind left-over constants

557

                                                 collect (list alias equivalent))

558

(next-solution-location)

559

                                       (locally (declare (type (simple-array fixnum (* ,projection-variable-count)) result-page)

560

                                                         (type fixnum result-index)

561

                                                         (ftype (function (t) fixnum) coerce-to-term-id)

562

                                                         (optimize ,@*field-optimization*))

563

                                         (setf ,@(loop for var-index from 0

564

                                                       for variable in projection-dimensions

565

                                                       nconc `((aref result-page result-index ,var-index)

566

                                                               (coerce-to-term-id ,variable))))))

567

'(next-solution-location)))

568

(next-solution-location ()

569

                                 ;; return a page (possible newly created) and the next free location in that page

570

(when (>= (incf result-index) result-page-length)

571

(when result-page (put-result result-page))

572

                                   (setf result-page (make-page result-page-length ,projection-variable-count)

573

result-index 0))

574

(values result-page result-index))

575

(complete-solutions ()

576

                                 (trace-bgp logical-bgp-match.complete-solutions result-count)

577

(incf *match-responses* match-result-count)

578

                                 (log-debug "bgp matches+counts: ~s: ~s/~s" repository-id match-result-count match-request-count)

579

(when result-page

580

(let ((page-result-count (1+ result-index)))

581

                                     (when (< page-result-count result-page-length)

582

(setf result-page

583

                                             (adjust-page result-page (list page-result-count ,projection-variable-count)))))

584

(put-result result-page))

585

(put-result nil)

586

;; (print (list :bgp result-count :complete))

587

(return-from :logical-bgp-match result-count))

588

(put-result (page)

589

                                 (trace-bgp bgp-match.enqueue bgp-continuation ',projection-dimensions page)

590

(put-field-page bgp-continuation page)

591

(unless (task-active-p *query*)

592

                                   (when page (put-field-page bgp-continuation nil))

593

(return-from :logical-bgp-match result-count))))

594

(trace-bgp logical-bgp.start ',id (task-id *query*)

595

                                   (repository-id repository) (repository-revision-id repository) ',projection-dimensions)

596

(incf-stat *algebra-operations*)

597

598

                        ;; unless there are paths present (actually zero-length paths is the issue)

599

                        ;; require a revision id to perform the query - without a revision there can be no result, so skip it

600

(if ,(if property-paths

601

t

602

'(repository-revision-id repository))

603

(cffi:with-foreign-objects

604

                            (,@(mapcar #'(lambda (var) `(,var 'rdfcache::cursor)) *bgp-cursors*))

605

(unwind-protect

606

                              (progn ,@(mapcar #'(lambda (var) `(rdfcache::%clear-cursor ,var)) *bgp-cursors*)

607

                                     ,(let ((iterate-over-graphs `(labels ((match-patterns (,graph-variable)

608

                                                                             ;; if the graph is to be matched, it is rebound in the matching form

609

                                                                             (declare (ignorable ,graph-variable))

610

                                                                             (flet ((complete-graph-solutions ()

611

                                                                                      ;; provide a graph-specific return control transfer to allow

612

                                                                                      ;; the match to repeat for each of an explicit graph set

613

                                                                                      (return-from match-patterns)))

614

                                                                               (,form-lambda)))

615

                                                                           (collect-solution ()

616

                                                                             (collect-solution-variables ,@collection-variables)))

617

                                                                    ,(cond (graphs

618

                                                                            ;; if the dataset was specified, use it and respect any initial solution constraint

619

                                                                            (if initial-solution-graph-variable

620

                                                                              `(progn ,@(loop for graph in graphs

621

                                                                                              collect `(cond ((eql ,wildcard-term initial-solution-graph-variable)

622

                                                                                                              (match-patterns ,graph))

623

                                                                                                             ((spocq.e:equal ,initial-solution-graph-variable ,graph)

624

                                                                                                              (return (match-patterns ,graph))))))

625

                                                                              `(progn ,@(loop for graph in graphs

626

                                                                                              collect `(match-patterns ,graph)))))

627

                                                                           (graph

628

                                                                            ;; if in a graph clause, if there was no dataset declared, search.

629

                                                                            ;; otherwise, the effective dataset includes no named graph

630

                                                                            ;; see rdf-sparql-query 8.2.1

631

                                                                            (if initial-solution-graph-variable

632

                                                                              `(match-patterns ,graph)

633

                                                                              (if default-graphs

634

nil

635

                                                                                `(match-patterns ,named-contexts-term-number))))

636

(t

637

                                                                            ;; outside of a graph clause, the analogous applies

638

                                                                            ;; if there is no dataset clause, use the default graph.

639

                                                                            ;; otherwise the default graph is empty.

640

                                                                            (if named-graphs

641

nil

642

                                                                              `(match-patterns ,default-context-term-number)))))))

643

(if base-dimensions

644

                                          `(loop for page = (get-field-page source)

645

until (null page)

646

                                                 do ,(let ((macros (loop for variable in base-dimensions

647

                                                                         for i from 0

648

                                                                         collect `(,variable (aref page page-index ,i)))))

649

                                                       (when trace (print (cons :macros macros)))

650

                                                       `(locally (declare (type (simple-array fixnum (* ,(length base-dimensions))) page)

651

                                                                          (optimize ,@*field-optimization*))

652

                                                          (trace-data logical-bgp.dequeue bgp-continuation ',base-dimensions page (term-value-field page))

653

                                                          (loop for page-index from 0 below (array-dimension page 0)

654

                                                                  do (symbol-macrolet ,macros

655

                                                                       (trace-data logical-bgp.base-solution page-index)

656

                                                                       ,iterate-over-graphs)))))

657

iterate-over-graphs))

658

(complete-solutions))

659

                              ,@(mapcar #'(lambda (cursor) `(rdfcache:close ,cursor)) *bgp-cursors*)))

660

                          (progn (log-debug "suppress query for empty repository: ~a" repository-id)

661

(complete-solutions))))

662

(log-warn "incomplete bgp: ~s." ',id)

663

result-count))))))

664

(log-debug "query [~a] bgp [~a] lambda: ~s"

665

(task-id *query*) id query-lambda)

666

query-lambda))))

667

668

#|

669

(defparameter *sparql* "

670

select * where { ?uuu <rdfs:subPropertyOf> _:vvv .

671

_:vvv <rdfs:subPropertyOf> ?xxx }")

672

(parse-sparql *sparql*)

673

(let ((query (make-test-query :sse-expression (parse-sparql *sparql*)

674

:repository-id "0/0")))

675

(with-task-environment (:task query :normal-disposition :continue)

676

(compile-query query)

677

(mapcar #'agp-pattern-function (query-patterns query)))

678

query)

679

|#