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

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

;;; compile a bgp into a function which matches against an hdt database and

4

;;; performs the nested interation on the results.

5

6

7

(in-package :org.datagraph.spocq.implementation)

8

9

10

(defmethod compute-bgp-lambda ((repository hdt-repository) body &rest args)

11

(declare (dynamic-extent args))

12

(apply #'compute-hdt-statement-lambda repository body args))

13

14

(defgeneric compute-hdt-statement-lambda (repository body &key) )

15

16

17

(defmethod compute-hdt-statement-lambda ((repository hdt-repository) (body list) &key

18

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

19

                                                       (projection-dimensions (expression-dimensions body))

20

                                                       (wildcard-term (repository-wildcard-term-number repository))

21

                                                       default-context-term

22

                                                       named-contexts-term

23

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

24

                                                       (dataset-graphs nil)

25

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

26

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

27

                                                       (graphs nil)

28

                                                       (variables (if (variable-p graph)

29

                                                                      (cons graph (expression-variables body))

30

                                                                      (expression-variables body)))

31

                                                       (dynamic-variables ())

32

transaction

33

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

34

"Generate a matching operator from a BGP for direct HDT access path.

35

36

The base logic is a variant of rdfcache-based BGP evaluation:

37

   - there are no graphs : eventually, still for triple-realm hdt datasets, they could map to respective file

38

that requires multi-environment transactions

39

- initial constraints are accepted

40

41

in the initial version, the raph is just suppressed in the match call, never

42

assigned from match results and instead held to a constant in returned results

43

"

44

(declare (ignore transaction default-context-term

45

named-contexts-term))

46

(when (assoc 'spocq.a:|quad| body)

47

(error "invalid bpg pattern: ~s" body))

48

;; ensure uniqness

49

(setf variables (remove-duplicates variables :from-end t))

50

(when graphs ;; compatibility

51

(warn "graphs ignored ~s." graphs)

52

(log-warn "graphs ignored ~s." graphs))

53

;; use the dimensions provided in the call

54

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

55

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

56

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

57

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

58

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

59

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

60

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

61

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

62

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

63

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

64

;; extract and consolidate anu declaration clauses

65

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

66

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

67

;; in order to mirror any binding/setting

68

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

69

(pattern-count 1)

70

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

71

;; adjust bounds to account for per-thread cursors

72

(match-counters (loop for i from 0 below pattern-count collect (gensym "COUNTER")))

73

(temp-match-counters match-counters)

74

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

75

(perform-slice-offset (typep slice-offset '(integer 1)))

76

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

77

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

78

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

79

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

80

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

81

(blank-node-map (loop for node in blank-nodes

82

if (spocq:blank-node-constant-p node)

83

do (error "no constant blank nodes permitted: ~s: ~s"

84

repository body)

85

else collect (cons node (cons-variable))))

86

(default-context-term-number -1)

87

(named-contexts-term-number -2)

88

;; track the match nesting; the outer loop only must bind the graph

89

(iteration-level 0)

90

(base-bindings base-dimensions)

91

(initial-bindings (union-dimensions base-bindings dynamic-variables))

92

(missing-terms ()) ;; trach terms for which no term number is known

93

)

94

(declare (ignore declarations))

95

96

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

97

(cond ((variable-p object)

98

object)

99

((spocq:blank-node-p object)

100

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

101

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

102

((property-path-p object)

103

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

104

(t

105

(let ((tn (hdt-object-term-number repository object role)))

106

(cond (tn )

107

                               (t  ;; track terms which are not present in the repository

108

(push object missing-terms)

109

-1))))))

110

(intern-graph-if-constant (object)

111

(declare (ignore object))

112

default-context-term-number)

113

(compute-filter-continuation (triples accumulated-variables)

114

;; filter terms supported as object only

115

(let* ((form (first triples))

116

(cc (compute-next-continuation (rest triples) accumulated-variables))

117

(test-expression (second form))

118

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

119

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

120

(if test-variables

121

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

122

`(if ((lambda ,test-aliases

123

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

124

                                                  for alias in test-aliases

125

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

126

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

127

,test-expression))

128

,@test-variables)

129

,cc

130

                         ;; must provide a true result if the filter fails for the scan to continue

131

t))

132

`(if ,test-expression ,cc t))))

133

(compute-statement-continuation (triples accumulated-variables)

134

(let* ((form (first triples))

135

(dimensions (cons graph-variable (statement-dimensions form)))

136

                       ;; the first match must always use the graph term - either a constant from/from-named iri

137

;; or one of the wild-card, designators default/named/all.

138

                       ;; if wild, then the result matters, but if constant, then the result does not.

139

                       ;; all subsequent iterations use the result from the first match and do not need to rebind

140

(is-first-iteration (= 1 (incf iteration-level)))

141

(last-triple-p (null (assoc 'spocq.a:|triple| (rest triples))))

142

                       ;; set the graph from each result for the outermost iteration only. that means:

143

                       ;; trying w/o this: nb. in contrast to the term-pointer version, which sets the pointer

144

                       ;; once only, the term-id based version must retrieve the id each iteration

145

                       (match-result-arguments (loop ;; for term in (cons graph-variable (statement-terms form))

146

                                                     for term in dimensions

147

                                                     collect (cond ((or (not (variable-p term)) (member term accumulated-variables))

148

                                                                    (gensym "constant"))

149

                                                                   ((and (eq term graph-variable)

150

                                                                         (not is-first-iteration))

151

                                                                    (gensym "constant-graph"))

152

(t

153

                                                                    term))))

154

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

155

                                                       for v in match-result-arguments

156

                                                       collect (if (member v (rest vars))

157

                                                                 (gensym)

158

                                                                 v))))

159

(labels (#+(or) (local-variable-p (v) (member v match-result-arguments))

160

                           #+(or) (wild-variable-p (v) (and (local-variable-p v) (not (eq v graph)))))

161

(let* ((match-pattern (cons graph-variable

162

                                                ;; replace a variable which was not yet returned from a match

163

                                                ;; (loop for term in (statement-terms form) collect (if (wild-variable-p term) wildcard-term term))

164

(statement-terms form)

165

))

166

                           (concrete-match-pattern (let ((graph-term (first match-pattern)))

167

                                                     (cons graph-term (loop for term in (rest match-pattern)

168

                                                                            collect (if (eq term graph-term)

169

                                                                                      `(max 0 ,term) ; cannot pass non-concrete term

170

                                                                                      term)))))

171

;; replaced with rdf-hdt call

172

                           ;; (match-form `(match-quad-cursor transaction-record ,@concrete-match-pattern *match-target-graph* nil nil))

173

                           (count-form `(count-quad-cursor %environment ,@concrete-match-pattern))

174

                           (accumulated-variables (append accumulated-variables (remove-if-not #'symbol-package match-result-arguments)))

175

(body (cond ((property-path-p (third match-pattern))

176

                                        ;; interpret a property path through an out-of-line call to the path matcher

177

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

178

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

179

                                               (match-aliases (loop for v in match-result-arguments

180

                                                                    for v-eq = (rassoc v equivalents)

181

                                                                    when v-eq

182

                                                                    collect v-eq

183

                                                                    and do (setf equivalents (remove v-eq equivalents))))

184

                                               (continuation-form (compute-next-continuation (rest triples) accumulated-variables)))

185

186

;; constrain aliased variables

187

                                          (unless (equal uniqued-result-arguments match-result-arguments)

188

(setf continuation-form

189

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

190

                                                                      for u in uniqued-result-arguments

191

                                                                      unless (eq u v)

192

                                                                      collect `(= ,u ,v)))

193

                                                     ,continuation-form

194

t)))

195

(when match-aliases

196

                                            #+(or)       ; eliminate alias-rebinding in favor of original dimensions

197

(setf continuation-form

198

                                                  `(let ,(loop for (alias . v) in match-aliases

199

                                                               collect `(,alias ,v))

200

                                                     ,continuation-form)))

201

                                          `(flet ((,path-continuation (,@uniqued-result-arguments)

202

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

203

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

204

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

205

                                                      (log-debug "bgp premature completion: ~a" *query*)

206

                                                      (complete-solutions))

207

                                                    ;; when coercing solution graph, restore the match to the initial graphs

208

                                                    ,@(when is-first-iteration

209

                                                        `((note-graph-reference ,(first uniqued-result-arguments))))

210

                                                    ,(if (and perform-slice-offset last-triple-p)

211

                                                         ;;when here, to return nil to statement mapper

212

                                                         `(when (minusp (decf solution-offset))

213

                                                            ,continuation-form)

214

                                                         continuation-form)))

215

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

216

                                             (trace-bgp bgp.pp-to-match ',concrete-match-pattern)

217

                                             (when *match-target-graph* (setf ,graph-variable effective-dataset-graphs))

218

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

219

220

                                       ((extension-operator-p (third match-pattern))

221

                                        ;; interpret a property function through an out-of-line call to funcall-extension

222

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

223

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

224

                                               (match-aliases (loop for v in match-result-arguments

225

                                                                    for v-eq = (rassoc v equivalents)

226

                                                                    when v-eq

227

                                                                    collect v-eq

228

                                                                    and do (setf equivalents (remove v-eq equivalents))))

229

                                               (continuation-form (compute-next-continuation (rest triples) accumulated-variables)))

230

231

;; constrain aliased variables

232

                                          (unless (equal uniqued-result-arguments match-result-arguments)

233

(setf continuation-form

234

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

235

                                                                      for u in uniqued-result-arguments

236

                                                                      unless (eq u v)

237

                                                                      collect `(= ,u ,v)))

238

                                                     ,continuation-form

239

t)))

240

(when match-aliases

241

                                            #+(or)       ; eliminate alias-rebinding in favor of original dimensions

242

(setf continuation-form

243

                                                  `(let ,(loop for (alias . v) in match-aliases

244

                                                               collect `(,alias ,v))

245

                                                     ,continuation-form)))

246

                                          `(flet ((,extension-continuation (,@uniqued-result-arguments)

247

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

248

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

249

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

250

                                                      (log-debug "bgp premature completion: ~a" *query*)

251

                                                      (complete-solutions))

252

                                                    ;; when coercing solution graph, restore the match to the initial graphs

253

                                                    ,@(when is-first-iteration

254

                                                        `((note-graph-reference ,(first uniqued-result-arguments))))

255

                                                    ,(if (and perform-slice-offset last-triple-p)

256

                                                         ;;when here, to return nil to statement mapper

257

                                                         `(when (minusp (decf solution-offset))

258

                                                            ,continuation-form)

259

                                                         continuation-form)))

260

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

261

                                             (trace-bgp bgp.extension ',concrete-match-pattern)

262

                                             (when *match-target-graph* (setf ,graph-variable effective-dataset-graphs))

263

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

264

265

((find-if #'variable-p match-pattern)

266

                                        ;; iterate over the bindings emitted from the hdt index

267

                                        (let* ((hdt-continuation (gensym "HDT-CONTINUATION"))

268

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

269

                                               (continuation-form (compute-next-continuation (rest triples) accumulated-variables))

270

)

271

;; constrain aliased variables

272

                                          (unless (equal uniqued-result-arguments match-result-arguments)

273

(setf continuation-form

274

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

275

                                                                  for u in uniqued-result-arguments

276

                                                                  unless (eq u v)

277

                                                                  collect `(= ,u ,v)))

278

                                                     ,continuation-form

279

t)))

280

                                          `(flet ((,hdt-continuation ,(rest uniqued-result-arguments)

281

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

282

                                                    (trace-bgp bgp.hdt-matched ,@(rest uniqued-result-arguments))

283

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

284

                                                      (log-debug "bgp premature completion: ~a" *query*)

285

                                                      (complete-solutions))

286

                                                    ;; when coercing solution graph, restore the match to the initial graphs

287

                                                    ,continuation-form))

288

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

289

                                             (trace-bgp bgp.hdt-to-match ',concrete-match-pattern)

290

                                             (when *match-target-graph* (setf ,graph-variable effective-dataset-graphs))

291

                                             (hdt:%map-repository-statements* #',hdt-continuation %environment

292

                                                                              ,@(rest concrete-match-pattern)))))

293

(t

294

;; just count

295

                                        (let ((continuation-form (compute-next-continuation (rest triples) accumulated-variables)))

296

                                          (unless (equal uniqued-result-arguments match-result-arguments)

297

(setf continuation-form

298

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

299

                                                                      for u in uniqued-result-arguments

300

                                                                      unless (eq u v)

301

                                                                      collect `(= ,u ,v)))

302

                                                     ,continuation-form

303

t)))

304

                                          (if (and perform-slice-offset last-triple-p)

305

;; constant slice

306

`(progn (incf match-requests)

307

                                                    (let ((count ,count-form))

308

                                                      (cond ((and (plusp count)

309

                                                                  (not (plusp (decf solution-offset count))))

310

                                                             (incf match-results)

311

                                                             (incf ,(pop temp-match-counters))

312

                                                             ,continuation-form)

313

                                                            (t t))))

314

;; constant match

315

`(progn (incf match-requests)

316

                                               (cond ((plusp ,count-form)

317

                                                      (incf match-results)

318

                                                      (incf ,(pop temp-match-counters))

319

                                                      ,continuation-form)

320

(t t)))))))))

321

body))))

322

323

(compute-base-continuation ()

324

;; set the next solution row

325

(let ((collect-form `(collect-solution ,@collection-variables)))

326

(if perform-slice-offset

327

(if slice-count

328

`(if (minusp (decf solution-offset))

329

(if (minusp (decf solution-count))

330

(complete-solutions)

331

,collect-form)

332

solution-offset)

333

`(if (minusp (decf solution-offset))

334

,collect-form

335

solution-offset))

336

(if slice-count

337

`(if (minusp (decf solution-count))

338

(complete-solutions)

339

,collect-form)

340

collect-form))))

341

342

(compute-next-continuation (triples accumulated-variables)

343

(if triples

344

(let* ((form (first triples))) ; (triple ?s ?p ?o)

345

(ecase (first form)

346

(spocq.a:|triple|

347

;; compule a triple/quad into a query/next continuation

348

(compute-statement-continuation triples accumulated-variables))

349

(spocq.a:|filter|

350

                       ;; compile a filter into a constraint on the solutions which pass through it

351

(compute-filter-continuation triples accumulated-variables))))

352

(compute-base-continuation)))

353

(free-variable-p (term)

354

(and (variable-p term) (not (member term initial-bindings))))

355

(pattern-cost (stmt)

356

(+ (if (free-variable-p (statement-subject stmt)) 1 0)

357

(if (free-variable-p (statement-object stmt)) 1 0)

358

(if (property-path-p (statement-predicate stmt)) 1 0)))

359

(filters-pattern-p (filter stmt)

360

(let ((stmt-terms (subseq stmt 1 4))

361

(filter-vars (expression-variables filter)))

362

(intersection filter-vars stmt-terms))))

363

364

(setf iteration-patterns (loop for (tag . spo) in iteration-patterns

365

collect (ecase tag

366

(spocq.a:|triple|

367

                                                 (destructuring-bind (s p o &rest args) spo

368

                                                   `(,tag ,(intern-if-constant s :subject)

369

                                                          ,(if (extension-operator-p p)

370

371

                                                             (intern-if-constant p :predicate))

372

                                                          ,(intern-if-constant o :object)

373

                                                          ,@args)))

374

(spocq.a:|filter|

375

(cons tag spo)))))

376

;; prefer constants early and paths late

377

(setf iteration-patterns (partial-order-sort iteration-patterns

378

                                                    #'(lambda (s1 s2)

379

                                                        (ecase (first s1)

380

                                                          (spocq.a:|triple|

381

                                                            (ecase (first s2)

382

                                                              (spocq.a:|triple|

383

                                                                (< (pattern-cost s1) (pattern-cost s2)))

384

                                                              (spocq.a:|filter|

385

                                                                (filters-pattern-p s2 s1))))

386

                                                          (spocq.a:|filter|

387

                                                            (ecase (first s2)

388

                                                              (spocq.a:|triple|

389

                                                                (filters-pattern-p s1 s2))

390

                                                              (spocq.a:|filter| nil)))))))

391

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

392

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

393

(when (and (null default-graphs) (null named-graphs))

394

;; compose the "default dataset"

395

(setf default-graphs (list default-context-term-number)

396

named-graphs (list named-contexts-term-number)))

397

(when (some (complement #'plusp) named-graphs)

398

;; permit a singleton abstract graph only

399

(assert (null (rest named-graphs)) ()

400

"Invalid wildcard dataset named graphs specification: ~a." named-graphs)

401

(setf named-graphs (first named-graphs)))

402

(when (some (complement #'plusp) default-graphs)

403

(assert (null (rest default-graphs)) ()

404

"Invalid wildcard dataset default graph specification: ~a." default-graphs)

405

(setf default-graphs (first default-graphs)))

406

(setf equivalents (loop for (var . value-or-var) in equivalents

407

;; this needs to know the role !!!

408

;;!!! assume object

409

                           collect (cons var (intern-if-constant value-or-var  :object))))

410

411

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

412

(when (variable-p graph)

413

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

414

415

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

416

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

417

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

418

;;

419

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

420

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

421

;; start out as wild cards.

422

#+(or) ;; the initial call no longer includes constant terms

423

(base-bindings (if (or graphs (not graph))

424

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

425

base-dimensions))

426

;; this cannot work in this way, as it causes all variables to

427

;; be handled as if they are pre-bound, with the consequence, that

428

;; they are matched, but never extractedd from the cursor...

429

;; (initial-bindings (union-dimensions base-bindings variables))

430

(match-invocation-form

431

;; the effective process depends on a combination of :

432

;;

433

;; - the query graph term: null, variable, constant, abstract

434

;; - the dataset default graphs: null, constant, singleton abstract

435

;; normalized above to reflect the default v/s declare composition

436

;; - the dataset named graphs: null, constant, singleton abstract

437

;; normalized above to reflect the default v/s declare composition

438

;; - a propagated solution graph: null, variable

439

;;

440

;; if graph is bound, the bgp is in a graph clause

441

               ;; - if dataset.named-graphs are supplied : they provide the argument for the initial

442

;; match and the result serves for successive, nested calls

443

;; - allow for propagation to be constrained by the dataset

444

;; - allow for - and constrain, a constant graph

445

;; - no dataset.named-graphs

446

;; no match is possible

447

;; no graph indicates the bgp is outside the scope of a graph clause

448

;; - if dataset.default-graphs are supplied : match them the first time _and_

449

               ;;   also for subsequent matches, but substitute the default graph in the result field

450

;; - no dataset.default-graphs

451

;; no match is possible

452

;;

453

               ;; the dataset definition can be a singleton set of a designator for default, named, or all

454

               ;; graphs, in which case the role when matching is the same os that of a concrete graph

455

;;

456

(if graph

457

;; in the scope of a graph clause

458

(cond (named-graphs

459

                          ;; if the dataset definition includes named graphs, permit propgation, constants, or a dynamic binding

460

(cond (initial-solution-graph-variable

461

;; propagate form outside the bgp

462

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

463

(match-patterns ',named-graphs)

464

                                      (when ,(or (eql named-contexts-term-number named-graphs)

465

                                                 (eql wildcard-term named-graphs)

466

                                                 (if (consp named-graphs)

467

                                                     `(member ,initial-solution-graph-variable ',named-graphs)

468

                                                     `(eql ,initial-solution-graph-variable ,named-graphs)))

469

                                          (match-patterns ,initial-solution-graph-variable))))

470

((variable-p graph)

471

`(if (not (eql ,graph ,wildcard-term))

472

                                      (when ,(or (eql named-contexts-term-number named-graphs)

473

                                                 (eql wildcard-term named-graphs)

474

                                                 (if (consp named-graphs)

475

                                                     `(member ,graph ',named-graphs)

476

                                                     `(eql ,graph ,named-graphs)))

477

(match-patterns ,graph))

478

(match-patterns ',named-graphs))

479

;; bind aa request argument or match as wild

480

#+(or)

481

`(let ((argument (query-binding-value ',graph)))

482

(if (integerp argument)

483

                                        ;; execute with a request parameter if the dataset graphs permit

484

                                        (when ,(or (eql named-contexts-term-number named-graphs)

485

                                                   (eql wildcard-term named-graphs)

486

                                                   (if (consp named-graphs)

487

                                                       `(member argument ',named-graphs)

488

                                                       `(eql argument ,named-graphs)))

489

(match-patterns argument))

490

                                        ;; otherwise, start the match unbound

491

(match-patterns ',named-graphs))))

492

((iri-p graph)

493

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

494

                                 ;; match concrete literal or abstract (named, all)

495

                                 (when (or (eql named-contexts-term-number named-graphs)

496

(eql wildcard-term named-graphs)

497

(eql graph named-graphs)

498

                                           (and (consp named-graphs) (member graph named-graphs)))

499

`(match-patterns ,graph)))

500

(t

501

(error "Invalid graph term: ~s." graph))))

502

(t

503

                          ;; if the dataset includes no named graph, then a graph term cannot match

504

;; see 13.2.1: the dataset includes no named graphs

505

nil))

506

(cond (default-graphs

507

                             ;; iff merging into the default graph, the match result must be coerced

508

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

509

(t

510

nil))))

511

(triple-matching-form (compute-next-continuation iteration-patterns initial-bindings)))

512

         ;; (print (list :match-invocation-form match-invocation-form :graph graph :named-graphs named-graphs))

513

(when trace

514

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

515

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

516

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

517

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

518

;; without base dimensions, it runs autonomously.

519

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

520

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

521

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

522

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

523

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

524

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

525

;; materialization. for example an expression of the form

526

;;

527

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

528

;;

529

;; would reduce with data flow

530

;;

531

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

532

;;

533

;; but match with data flow

534

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

535

;;

536

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

537

538

(let* ((all-bgp-variables

539

;; look for a dynamic binding for all variables in the bgp

540

                 ;; this allows to specify dynamic variables retrospectively, but it may introduce

541

;; an issue related to extracting them from the cursor

542

(set-difference variables base-bindings))

543

(query-lambda

544

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

545

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

546

(assert-argument-types bgp-match

547

                                          (bgp-destination (or channel function))

548

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

549

(let* ((repository-id (repository-id *repository*))

550

(revision-id (repository-revision-id *task*))

551

(transaction *transaction*)

552

(transaction-record (transaction-record transaction))

553

(%environment (repository-hdt-environment *repository*))

554

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

555

(match-requests 0)

556

(match-results 0)

557

(missing-terms ',missing-terms)

558

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

559

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

560

(result-page nil)

561

(result-page-length (channel-page-length bgp-destination))

562

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

563

(result-count 0)

564

(last-graph-id 0)

565

                          (first-transaction-ordinal (transaction-min-revision-ordinal transaction))

566

                          (last-transaction-ordinal (transaction-max-revision-ordinal transaction))

567

(graph-ids-read (make-term-id-cache :single-thread t))

568

(*wildcard-identifier* ,wildcard-term)

569

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

570

,@(loop for var in match-counters collect `(,var 0))

571

                          ;; the original formulation looked for dynamic bindings for all variables

572

                          ;; which were specified as dynamic in the first request but provided to

573

;; be accepted from a propagation source

574

#+(or)

575

                          ,@(loop for var in (intersection (set-difference dynamic-variables base-bindings) variables)

576

                                  collect `(,var (query-binding-term-number ',var)))

577

,@(loop for var in all-bgp-variables

578

                                  collect `(,var (query-binding-term-number ',var)))

579

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

580

when (variable-p var)

581

collect `(,var ,wildcard-term))

582

)

583

                     (declare (ignorable repository-id revision-id transaction-record %environment)         ; if just paths

584

                              (ignorable first-transaction-ordinal last-transaction-ordinal) ; if no patterns

585

)

586

                     ,@(when all-bgp-variables ; a variable may have been folded into a constant

587

`((declare (ignorable ,@all-bgp-variables))))

588

(block :bgp-match

589

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

590

(typecase term-number

591

(fixnum term-number)

592

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

593

+null-term-id+)))

594

(collect-solution ,collection-variables

595

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

596

(case *match-target-graph*

597

((nil) )

598

(-1 )

599

                                    (t (log-warn "anomalous match target graph: ~s." *match-target-graph*)))

600

(incf result-count)

601

,(if projection-dimensions

602

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

603

                                                  collect (list alias equivalent))

604

(next-solution-location)

605

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

606

                                                          (type fixnum result-index)

607

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

608

                                                          (optimize ,@*field-optimization*))

609

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

610

                                                        for variable in projection-dimensions

611

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

612

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

613

'(next-solution-location))

614

result-count)

615

(next-solution-location ()

616

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

617

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

618

(unless (check-query-status)

619

(complete-solutions))

620

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

621

                                    (setf result-page (new-field-page bgp-destination result-page-length ,projection-variable-count)

622

result-index 0))

623

(values result-page result-index))

624

(complete-solutions ()

625

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

626

(incf *match-requests* match-requests)

627

(incf *match-responses* match-results)

628

(when (plusp (hash-table-count graph-ids-read))

629

                                    (with-locked-cache ((transaction-read-graph-ids transaction))

630

                                      (loop for id being each hash-key of graph-ids-read

631

                                            do (setf (transaction-graph-id-read transaction id) t))))

632

                                  (log-debug "bgp matches+counts: ~s: requests: ~s, matches: (~s ~s), solutions: ~s"

633

                                             repository-id match-requests match-results (list ,@match-counters) result-count)

634

(when result-page

635

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

636

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

637

(setf result-page

638

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

639

(put-result result-page))

640

(complete-field bgp-destination)

641

(incf-stat *solutions-constructed* result-count)

642

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

643

(put-result (page)

644

                                  (trace-bgp bgp.put bgp-destination ',projection-dimensions page)

645

(put-field-page bgp-destination page)

646

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

647

(complete-field bgp-destination)

648

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

649

(note-graph-reference (graph)

650

(unless (eql graph last-graph-id)

651

(setf last-graph-id graph)

652

(setf (gethash graph graph-ids-read) t)))

653

;; retained for alternative indices.

654

                                (count-quad-cursor (%environment context subject predicate object)

655

(declare (ignore context))

656

                                  (hdt::%hdt-read-term-pattern-count %environment subject predicate object))

657

)

658

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

659

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

660

                         ;; (print (list :bgp.start ',id (task-id *query*) repository-id revision-id ',projection-dimensions))

661

(incf-stat *algebra-operations*)

662

                         (trace-bgp bgp.repository *repository* repository-id revision-id :dataset ',dataset-graphs)

663

                         (if ,(if (find-if #'property-path-p body :key #'third) t 'revision-id)

664

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

665

                             ;; require an id to perform the query. otherwise there can be no result - skip it

666

(if missing-terms

667

(progn (trace-bgp bgp.suppress repository-id)

668

                                   (log-debug "suppress query for empty repository: ~a: terms ~s" repository-id missing-terms)

669

(complete-solutions))

670

(progn

671

                                   ; push this logic to the outer-most match call to pass

672

                                   ; the entire graph set as the context argument

673

                                   ,(let ((iterate-over-graphs `(flet ((match-patterns (effective-dataset-graphs &optional (*match-target-graph* nil)

674

                                                                                                                 ,@(when (eq graph-variable '.graph)

675

                                                                                                                     '(&aux (.graph *wildcard-identifier*)))

676

677

                                                                         ;; effective-dataset-graphs is the initial match set

678

                                                                         ;; *match-target-graph*, if bound indicates to coerce the graph term to that

679

                                                                         ;; if the graph is coerced, subsequent matches re-use the original set

680

                                                                         ;; this manages, eg. the case where a set of graphs is 'merged' into the

681

                                                                         ;; default graph, but the result must indicate the default graph only

682

                                                                         (trace-bgp bgp.next-graph effective-dataset-graphs *match-target-graph*)

683

                                                                         (let ((*match-property-path-context* effective-dataset-graphs))

684

                                                                           (when (= *wildcard-identifier* ,graph-variable)

685

                                                                             (setf ,graph-variable effective-dataset-graphs))

686

                                                                           ,triple-matching-form)))

687

                                                                  ,match-invocation-form)))

688

(when *compute-bgp-lambda.debug*

689

(pprint iterate-over-graphs))

690

(if base-dimensions

691

`(do-pages (page source)

692

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

693

                                                                      for i from 0

694

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

695

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

696

                                                                           (optimize ,@*field-optimization*))

697

                                                           (assert (and (typep page '(simple-array fixnum))

698

                                                                        (= (array-dimension page 1) ,(length base-dimensions)))

699

()

700

                                                                   "Invalid propagated page: ~s" page)

701

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

702

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

703

                                                             do (symbol-macrolet ,macros

704

                                                                                 ,iterate-over-graphs)))))

705

iterate-over-graphs))

706

(trace-bgp bgp.complete-after-graph-iteration)

707

(complete-solutions)))

708

(progn (trace-bgp bgp.suppress repository-id)

709

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

710

(complete-solutions))))

711

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

712

result-count)))))

713

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

714

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

715

query-lambda)))))

716

717

718

719

;;; path support

720

721

722

723

;;; matrix support

724

725

(defmethod repository-match-matrix ((transaction hdt-transaction) matrix context subject predicate object

726

&key (start 0) end)

727

"generate a new solution matrix for the statements which match the argument pattern.

728

  If the context is not yet interned, intern all terms and recurse. should some term not be present, then return

729

a null matrix. Associate a (possible sparse) dimension list with the result to indicate which columns

730

were variables."

731

(declare (ignore context))

732

(assert (typep start '(integer 0)) () "repository-match-matrix: invalid start: ~s" start)

733

   (assert (or (null end) (and (typep end '(integer 0)) (>= end start))) () "repository-match-matrix: invalid end: ~s" end)

734

(let* ((results ())

735

(result-count 0)

736

(limit (when end (- end start))))

737

(flet ((match-graph ()

738

(flet ((continue-with-statement (s p o)

739

(cond ((and limit (zerop limit))

740

nil)

741

((zerop start)

742

(push (list s p o) results)

743

(incf result-count))

744

(t

745

(decf start)))))

746

(declare (dynamic-extent #'continue-with-statement))

747

                  (hdt:%map-repository-statements* #'continue-with-statement (repository-hdt-environment transaction)

748

                                                   subject predicate object))))

749

(match-graph)

750

(let ((%matrix (rdfcache:make-matrix result-count 4)))

751

(declare (type cffi-sys:foreign-pointer %matrix))

752

(cffi:with-foreign-object (%quad '(:struct rdfcache::quad))

753

           (setf (%quad-context %quad) (repository-default-context-term-number (transaction-repository transaction)))

754

(loop for (s p o) in results

755

for offset from (* (1- result-count) 4) downto 0

756

do (setf (%quad-subject %quad) s

757

(%quad-predicate %quad) p

758

(%quad-object %quad) o)

759

do (rlmdb.i::copy-quad-record %quad %matrix offset)))

760

(values %matrix result-count)))))

761

762

(defmethod repository-matrix-field ((transaction hdt-transaction) context subject predicate object

763

                                      &key (start 0) end dimensions (wild-blank-nodes-p t))

764

(declare (ignore context subject predicate object start end dimensions wild-blank-nodes-p))

765

;; nyi

766

(call-next-method))

767

768

 (defmethod map-repository-statements (function (transaction hdt-transaction) subject predicate object context &key

769

                                                (wildcard-term (repository-wildcard-term-number transaction)) (offset 0) count

770

                                                (default-graph-term-number (repository-default-context-term-number transaction)))

771

(declare (ignore context))

772

(flet ((continue-with-statement (s p o)

773

(funcall function default-graph-term-number s p o))

774

(continue-with-sliced-statement (s p o)

775

(cond ((<= (decf offset) 0)

776

;; continue until any limit is reached

777

(when (or (null count) (>= (decf count) 0))

778

(funcall function default-graph-term-number s p o)))

779

(t t))))

780

(declare (dynamic-extent #'continue-with-sliced-statement #'continue-with-statement))

781

     (hdt:%map-repository-statements* (if (or offset count) #'continue-with-sliced-statement #'continue-with-statement)

782

(repository-hdt-environment transaction)

783

(or subject wildcard-term)

784

(or predicate wildcard-term)

785

(or object wildcard-term))))

786

787

 (defmethod repository-call-with-matched-terms (function (transaction hdt-transaction) subject predicate object &key

788

                                                         (wildcard-term (repository-wildcard-term-number transaction))

789

                                                         context

790

                                                         (target-graph (repository-default-context-term-number transaction))

791

                                                         (ordered-p nil))

792

(declare (ignore ordered-p)

793

(ignore context))

794

(flet ((continue-with-statement (s p o)

795

(funcall function target-graph s p o)))

796

(declare (dynamic-extent #'continue-with-statement))

797

(hdt:%map-repository-statements* #'continue-with-statement (repository-hdt-environment *transaction*)

798

(or subject wildcard-term)

799

(or predicate wildcard-term)

800

(or object wildcard-term))))

801

802