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

Kind	Covered	All	%
expression	186	271	68.6
branch	22	36	61.1

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-

2

3

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

4

5

(:documentation "store api additions for query/update processing"

6

"This includes mechanisms to intern/externailze object relative to rdf cache.")

7

8

9

(unless (fboundp 'rdfcache::is-string)

10

(defun rdfcache::is-string (term-number)

11

(and (eq (rdfcache:fetch-term-type term-number) :literal)

12

(eql 0 (dydra-ndk:term-datatype-id term-number)))))

13

14

(defmacro rdfcache-match (transaction cursor context subject predicate object)

15

`(progn (incf *match-requests*)

16

(rdfcache:match ,transaction ,cursor ,context ,subject ,predicate ,object)))

17

18

#+(or)

19

(defmacro rdfcache-match (transaction cursor context subject predicate object)

20

`(let ((.c. ,context)

21

(.s. ,subject)

22

(.p. ,predicate)

23

(.o. ,object))

24

(print-term-strings .c.)

25

(print-term-strings .s.)

26

(print-term-strings .p.)

27

(print-term-strings .o.)

28

(terpri)

29

(rdfcache:match ,transaction ,cursor .c. .s. .p. .o.)))

30

31

;;; due to repeated

32

 ;;;    libdydra error in rdfcache_ffi_count: Input/output error (errno=5) unknown transaction: 4749cc49-d7a2-11ea-b9ca-901b0e95d742

33

;;; wrapped counts to muffle the error

34

 ;;; did not do the same for next as they are much more frequent and wrapping each in an error handler would be

35

 ;;; too slow. if anything, this should end up in the bgp processing operator, to have it just complete the scan

36

37

#+(or)

38

(defmacro rdfcache-count (transaction-record context subject predicate object)

39

`(rdfcache:count ,transaction-record ,context ,subject ,predicate ,object))

40

41

(defun rdfcache-count (transaction-record context subject predicate object)

42

(handler-case

43

(rdfcache:count transaction-record context subject predicate object)

44

(error (c)

45

(log-error "rdfcache-count: ignored error: ~a" c)

46

0)))

47

48

(defmacro rdfcache-declare-terms (cursor context subject predicate object)

49

`(rdfcache:declare-terms ,cursor ,context ,subject ,predicate ,object))

50

51

(defmacro rdfcache-next (cursor)

52

`(rdfcache:next ,cursor))

53

54

55

#+(or) ; patch for possible race - replaced with general lock

56

(progn

57

(defparameter *rdfcache-fetch-term* (symbol-function 'rdfcache:fetch-term*))

58

(defparameter *rdfcache-fetch-term-lock* nil)

59

(defun rdfcache-fetch-term-lock ()

60

(or *rdfcache-fetch-term-lock*

61

(setq *rdfcache-fetch-term-lock* (bt:make-lock))))

62

(defun rdfcache:fetch-term* (&rest args)

63

(let ((lock (rdfcache-fetch-term-lock)))

64

(bt:with-lock-held (lock)

65

(apply *rdfcache-fetch-term* args))))

66

)

67

68

#+(or)

69

(progn

70

(defmacro rdfcache-match (transaction cursor context subject predicate object)

71

`(rdfcache-match-verbose-id ,transaction ,cursor ,context ,subject ,predicate ,object))

72

73

(defmacro rdfcache-count (transaction context subject predicate object)

74

`(rdfcache-count-verbose-id ,transaction ,context ,subject ,predicate ,object))

75

76

(defmacro rdfcache-next (cursor)

77

`(rdfcache-next-verbose-id ,cursor))

78

)

79

80

81

(defmacro with-terms (term-bindings &rest body)

82

(macroexpand-with-terms term-bindings body))

83

84

(defun macroexpand-with-terms (term-bindings body)

85

(let* ((body-proper (member 'declare body :key #'first :test-not #'eq))

86

(declarations (ldiff body body-proper))

87

(term-variables (mapcar #'first term-bindings))

88

(term-forms (mapcar #'second term-bindings))

89

(body-form `(progn ,@body-proper))

90

(unwind-clauses ()))

91

     `(cffi:with-foreign-objects ,(mapcar #'(lambda (variable) `(,variable '(:struct rdfcache::term))) term-variables)

92

,@declarations

93

(unwind-protect

94

,(loop for term-variable in term-variables

95

for term-form in term-forms

96

do (setf body-form

97

(multiple-value-bind (bindings initializations finalizations)

98

                                               (compute-term-initializer term-variable term-form)

99

(setf unwind-clauses (append unwind-clauses finalizations))

100

(cond (bindings

101

(destructuring-bind (op bindings) bindings

102

`(,op ,bindings ,@initializations

103

                                             ;; ,@(mapcar #'(lambda (var) `(intern-term ,var)) term-variables)

104

,body-form)))

105

(initializations

106

`(progn ,@initializations

107

                                             ;; ,@(mapcar #'(lambda (var) `(intern-term ,var)) term-variables)

108

,body-form))

109

(t

110

body-form))))

111

finally (return body-form))

112

,@unwind-clauses))))

113

114

115

(defmacro with-pattern-term-numbers (term-bindings &body body)

116

"Establish a contour in which each variable is bound to

117

- a term number when the respective form is a literal or uri constant

118

- the wildcard term number if the respective form is a variable or a blank node"

119

(let ((x-action (gensym "transaction"))

120

(coerce (gensym "coerce")))

121

`(let* ((,x-action (transaction-record *transaction*)))

122

(flet ((,coerce (term)

123

(if (or (null term) (spocq:blank-node-p term) (variable-p term))

124

rdfcache:*wildcard-term-number*

125

(rdfcache-object-term-number ,x-action term))))

126

          (let ,(loop for (variable expression) in (mapcar #'(lambda (b) (if (consp b) b (list b b))) term-bindings)

127

collect `(,variable (,coerce ,expression)))

128

,@body)))))

129

130

(defvar *rdfcache-timeout* 2000)

131

132

133

(defmethod initialize-store ((repository rdfcache-repository) (store-uri t) (store-library t))

134

(handler-bind ((warning #'muffle-warning))

135

(rdfcache:load-library :path store-library))

136

(rdfcache:attach)

137

;; bind vocabulary uri objects to their lexical and store designators

138

(initialize-interned-terms )

139

#+(or) ;; all term-number-object access now directly through rlmdb

140

(define-rdfcache-typed-term-number-object-methods)

141

)

142

143

(defmethod reinitialize-store ((repository rdfcache-repository))

144

(rdfcache:attach))

145

146

147

148

149

;;; (cffi:close-foreign-library (first (CFFI:LIST-FOREIGN-LIBRARIES)))

150

151

152

(cffi:defcallback signal-error :void ((message :pointer))

153

(error 'rdfcache::rdfcache-error

154

:format-control "signalled from rdfcache internals: ~a."

155

:format-arguments (list (cffi::foreign-string-to-lisp message))))

156

157

(defclass store () ())

158

159

(defclass rdfcache-store (store) ())

160

161

(defparameter *connection-timeout* 500)

162

163

164

(defclass rdfcache-store (store)

165

((query-operator :initform 'rdfcache::query :initarg :query-operator

166

:reader test-store-query-operator)))

167

168

(undefun call-with-rdfcache-cursor (op)

169

(declare (dynamic-extent op))

170

(with-cursor-record (%cursor)

171

(rdfcache::%clear-cursor %cursor)

172

(unwind-protect (funcall op %cursor)

173

(rdfcache:close %cursor))))

174

175

176

177

 (undefmethod transaction-call-with-matched-terms (op (transaction rdfcache-transaction) subject predicate object &key (context (repository-wildcard-term *transaction*))

178

                                                    (target-graph nil) (ordered-p nil))

179

(let* ((%transaction (transaction-record transaction))

180

(%match-cursor (rdfcache::make-quad-cursor %transaction context subject predicate object

181

                                              :graph target-graph :ordered ordered-p)))

182

(unwind-protect

183

(loop (unless (dydra-ndk::quad-cursor-next %match-cursor) (return))

184

(funcall op

185

(dydra-ndk::quad-cursor-graph-id %match-cursor)

186

(dydra-ndk::quad-cursor-subject-id %match-cursor)

187

(dydra-ndk::quad-cursor-predicate-id %match-cursor)

188

(dydra-ndk::quad-cursor-object-id %match-cursor)))

189

(when %match-cursor

190

(dydra-ndk::free-quad-cursor %match-cursor)))))

191

192

193

;;; statistics

194

195

(undefmethod repository-pattern-count ((repository rdfcache-repository) subject predicate object context)

196

(let ((stats (repository-statistics repository))

197

(pattern (list subject predicate object context)))

198

(declare (dynamic-extent pattern))

199

(if (operation-read-only-p *task*)

200

(or (gethash pattern stats)

201

(setf (get-registry (copy-list pattern) stats)

202

(read-repository-pattern-count repository subject predicate object context)))

203

(read-repository-pattern-count repository subject predicate object context))))

204

205

(undefmethod read-repository-pattern-count ((repository rdfcache-repository) subject predicate object context)

206

;; ensure that the repository has at least one commit and that it is bound to a concrete store

207

(if (and (repository-revision-id repository)

208

(repository-store-uri repository))

209

(flet ((read-pattern-count ()

210

(repository-pattern-count *transaction* subject predicate object context)))

211

(if *transaction*

212

(read-pattern-count)

213

(with-open-transaction (repository) (read-pattern-count))))

214

;; otherwise, it is empty

215

0))

216

217

(undefmethod repository-pattern-count ((transaction rdfcache-transaction) subject predicate object context)

218

(let* ((x-record (transaction-record transaction))

219

(context (case context

220

((nil)

221

rdfcache:*wildcard-term-number*)

222

(|urn:dydra|:|all|

223

(repository-all-contexts-term-number transaction)) ;;

224

(|urn:dydra|:|default| ;; (|urn:dydra|:|default| nil)

225

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

226

(|urn:dydra|:|named|

227

(repository-named-contexts-term-number transaction))

228

(t

229

(if (variable-p context)

230

(ecase (named-contexts-term)

231

                            (|urn:dydra|:|all| (repository-all-contexts-term-number transaction))

232

                            (|urn:dydra|:|default| (repository-default-context-term-number transaction))

233

                            (|urn:dydra|:|named| (repository-named-contexts-term-number transaction)))

234

(rdfcache-object-term-number x-record context))))))

235

(with-pattern-term-numbers (subject predicate object)

236

(rdfcache-count x-record context subject predicate object))))

237

238

 ;;; (defmethod repository-pattern-count :before ((transaction rdfcache-transaction) subject predicate object context) (print "repository-pattern-count: xaction")  (rdfcache:print-transaction (transaction-record transaction)))

239

240

(undefmethod read-repository-statement-count ((repository rdfcache-repository))

241

;; ensure that the repositry has at least one commit ans that it is bounds to a concrete store

242

(if (and (repository-revision-id repository)

243

(repository-store-uri repository))

244

(flet ((read-statement-count ()

245

              (rdfcache-count (transaction-record *transaction*) (repository-all-contexts-term-number repository)

246

                              rdfcache:*wildcard-term-number* rdfcache:*wildcard-term-number* rdfcache:*wildcard-term-number*)))

247

(if *transaction*

248

(read-statement-count)

249

(with-open-transaction (repository) (read-statement-count))))

250

1))

251

252

(undefmethod read-repository-statement-count ((transaction rdfcache-transaction))

253

;; ensure that the repositry has at least one commit ans that it is bounds to a concrete store

254

(rdfcache-count (transaction-record transaction) rdfcache:*all-context-number*

255

                   rdfcache:*wildcard-term-number* rdfcache:*wildcard-term-number* rdfcache:*wildcard-term-number*))

256

(undefmethod read-repository-statement-count ((transaction rdfcache-transaction))

257

(call-next-method))

258

259

;;; iteration

260

261

(undefun rdfcache-context-term-number (transaction context)

262

(case context

263

((nil t :default) (repository-default-context-term-number transaction))

264

(|urn:dydra|:|default| rdfcache:*default-context-number*)

265

(|urn:dydra|:|named| rdfcache:*named-context-number*)

266

(|urn:dydra|:|all| rdfcache:*all-context-number*)

267

(t

268

(cond ((iri-p context)

269

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

270

(t

271

(log-warn "invalid context term: ~s." context)

272

context)))))

273

274

(undefmethod repository-context-term-number ((repository-handle rdfcache-transaction) context)

275

(rdfcache-context-term-number repository-handle context))

276

(undefmethod repository-context-term-number ((repository-handle rdfcache-repository) context)

277

(rdfcache-context-term-number *transaction* context))

278

279

280

(undefmethod map-repository-contexts (function (repository-handle rdfcache-transaction) &key

281

(distinct t)

282

(default t))

283

;;(declare (dynamic-extent function))

284

(declare (ignore default))

285

(rdfcache:map-context-numbers function (transaction-record repository-handle) :distinct distinct))

286

287

288

(undefmethod map-repository-subjects (function (repository-handle rdfcache-transaction) &key

289

                                              (context nil) (distinct t))

290

(declare (dynamic-extent function))

291

(rdfcache:map-subject-numbers function (transaction-record repository-handle)

292

:distinct distinct

293

                                 :context (rdfcache-context-term-number repository-handle context)))

294

295

(undefgeneric map-repository-context-subjects (function repository-handle context &key distinct)

296

(:method (function (repository-handle rdfcache-transaction) (context integer) &key (distinct t))

297

#-sbcl (declare (dynamic-extent function))

298

(rdfcache:map-subject-numbers function (transaction-record repository-handle)

299

:distinct distinct

300

:context context))

301

(:method (function (repository-handle rdfcache-transaction) (context t) &key (distinct t))

302

#-sbcl (declare (dynamic-extent function))

303

     (map-repository-context-subjects function repository-handle (rdfcache-context-term-number repository-handle context)

304

:distinct distinct))

305

(:method (function (repository-handle rdfcache-transaction) (context cons) &key (distinct t))

306

#-sbcl (declare (dynamic-extent function))

307

(loop for context in context

308

do (map-repository-context-subjects function repository-handle context :distinct distinct))))

309

310

(undefgeneric map-repository-subjects-and-contexts (continuation repository-handle context &key distinct)

311

(:method (continuation (repository-handle rdfcache-transaction) (context integer) &key (distinct t))

312

#-sbcl (declare (dynamic-extent function))

313

(flet ((continue-with-context (subject)

314

(funcall continuation context subject)))

315

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

316

(rdfcache:map-subject-numbers #'continue-with-context (transaction-record repository-handle)

317

:distinct distinct

318

:context context)))

319

(:method (continuation (repository-handle rdfcache-transaction) (context t) &key (distinct t))

320

#-sbcl (declare (dynamic-extent continuation))

321

     (map-repository-subjects-and-contexts continuation repository-handle (rdfcache-context-term-number repository-handle context)

322

:distinct distinct))

323

(:method (continuation (repository-handle rdfcache-transaction) (context cons) &key (distinct t))

324

#-sbcl (declare (dynamic-extent continuation))

325

(loop for context in context

326

       do (map-repository-subjects-and-contexts continuation repository-handle context :distinct distinct))))

327

328

329

330

(undefmethod map-repository-predicates (function (repository-handle rdfcache-transaction) &key

331

                                                (context nil) (distinct t))

332

(declare (dynamic-extent function))

333

(rdfcache:map-predicate-numbers function (transaction-record repository-handle)

334

:distinct distinct

335

                                   :context (rdfcache-context-term-number repository-handle context)))

336

337

(undefmethod map-repository-objects (function (repository-handle rdfcache-transaction) &key

338

(context nil) (distinct t))

339

; (declare (dynamic-extent function))

340

(rdfcache:map-object-numbers function (transaction-record repository-handle)

341

:distinct distinct

342

                                :context (rdfcache-context-term-number repository-handle context)))

343

344

(undefgeneric map-repository-context-objects (function repository-handle context &key distinct)

345

(:method (function (repository-handle rdfcache-transaction) (context integer) &key (distinct t))

346

#-sbcl (declare (dynamic-extent function))

347

(rdfcache:map-object-numbers function (transaction-record repository-handle)

348

:distinct distinct

349

:context context))

350

(:method (function (repository-handle rdfcache-transaction) (context t) &key (distinct t))

351

#-sbcl (declare (dynamic-extent function))

352

     (map-repository-context-objects function repository-handle (rdfcache-context-term-number repository-handle context)

353

:distinct distinct))

354

(:method (function (repository-handle rdfcache-transaction) (context cons) &key (distinct t))

355

#-sbcl (declare (dynamic-extent function))

356

(loop for context in context

357

do (map-repository-context-objects function repository-handle context :distinct distinct))))

358

359

(undefgeneric map-repository-objects-and-contexts (continuation repository-handle context &key distinct)

360

(:method (continuation (repository-handle rdfcache-transaction) (context integer) &key (distinct t))

361

#-sbcl (declare (dynamic-extent function))

362

(flet ((continue-with-context (obbject)

363

(funcall continuation context obbject)))

364

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

365

(rdfcache:map-object-numbers #'continue-with-context (transaction-record repository-handle)

366

:distinct distinct

367

:context context)))

368

(:method (continuation (repository-handle rdfcache-transaction) (context t) &key (distinct t))

369

#-sbcl (declare (dynamic-extent function))

370

     (map-repository-objects-and-contexts continuation repository-handle (rdfcache-context-term-number repository-handle context)

371

:distinct distinct))

372

(:method (continuation (repository-handle rdfcache-transaction) (context cons) &key (distinct t))

373

#-sbcl (declare (dynamic-extent continuation))

374

(loop for context in context

375

       do (map-repository-objects-and-contexts continuation repository-handle context :distinct distinct))))

376

377

 (undefmethod map-repository-terms (function (transaction rdfcache-transaction) context key declarations &key (distinct t))

378

;; (declare (dynamic-extent function)) ; gets sbcl upset

379

(flet ((iterate-with-context (%context)

380

(let ((wildcard-term (repository-wildcard-term (transaction-repository transaction))))

381

(with-cursor-record (%cursor)

382

(rdfcache::term-cursor-init %cursor

383

                                            (if distinct rdfcache::RDFCACHE_TERM_CURSOR_DISTINCT 0)

384

key)

385

                (unwind-protect (progn (rdfcache::term-cursor-open (transaction-record transaction) %cursor %context)

386

                                       (loop (unless (rdfcache:term-cursor-next %cursor) (return))

387

                                        (funcall function (rdfcache:curor-term-number %cursor))))

388

(rdfcache:term-cursor-close %cursor))))))

389

(when (transaction-parent-p transaction)

390

;; iff it is not empty

391

(case context

392

((nil t :default)

393

          (iterate-with-context (repository-default-context-term-number (transaction-repository transaction))))

394

(t

395

(iterate-with-context context))))))

396

397

 (undefmethod map-repository-statements (function (transaction rdfcache-transaction) subject predicate object context &key offset count)

398

(let ((wildcard-term (repository-wildcard-term (transaction-repository transaction))))

399

(with-cursor-record (%cursor)

400

(rdfcache::%clear-cursor %cursor)

401

(unwind-protect (when (plusp (rdfcache-match (transaction-record transaction) %cursor

402

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

403

                                                    (or subject wildcard-term)

404

                                                    (or predicate wildcard-term)

405

                                                    (or object wildcard-term)))

406

                         (rdfcache::declare-terms %cursor :term-number :term-number :term-number :term-number)

407

(loop (unless (rdfcache-next %cursor) (return))

408

(cond ((and offset (plusp offset))

409

(decf offset))

410

(t

411

(when (and count (minusp (decf count)))

412

(return))

413

(funcall function

414

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

415

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

416

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

417

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

418

(rdfcache:close %cursor)))))

419

420

421

;;; side-effects

422

423

(defmethod repository-delete-field ((repository rdfcache-repository) (solution-field t))

424

(repository-delete-field *transaction* solution-field))

425

426

(defmethod repository-delete-field ((transaction rdfcache-transaction) (solution-field list))

427

(if solution-field

428

(repository-delete-field transaction (repository-intern-statements transaction solution-field))

429

0))

430

431

(defmethod repository-delete-field ((context t) (solution-field vector))

432

(loop for field across solution-field

433

sum (repository-delete-field context field)))

434

435

(defmethod repository-delete-field ((transaction rdfcache-transaction) (solution-field array))

436

(trace-algebra repository-delete-field transaction solution-field (term-value-field solution-field))

437

(assert-argument-type repository-delete-field solution-field

438

(or (simple-array fixnum (* 3)) (simple-array fixnum (* 4))))

439

(let ((%transaction (transaction-record transaction))

440

(provenance-p (case *provenance-mode*

441

(|urn:dydra|:|none| nil)

442

(t (when (task-provenance-repository *task*) t)))))

443

(ecase (array-dimension solution-field 1)

444

(3 (do-solution-field (subject predicate object) solution-field

445

                             (when (and (> subject 0) (> predicate 0) (> object 0))

446

                               (rdfcache::delete-statement %transaction rdfcache:*default-context-number*

447

                                                           subject predicate object))))

448

(4 (let ((field-graph 0))

449

;; modify the id list for any graph which appears

450

(do-solution-field (subject predicate object graph) solution-field

451

                               (when (and (> subject 0) (> predicate 0) (> object 0)

452

                                          (or (> graph 0) (= graph rdfcache:*default-context-number*)))

453

(when (and provenance-p (/= graph field-graph))

454

(setf field-graph graph)

455

                                   (setf (transaction-graph-id-modified *transaction* graph) t))

456

(record-modified-resource transaction subject)

457

(rdfcache::delete-statement %transaction graph

458

                                                             subject predicate object))))))

459

(array-dimension solution-field 0)))

460

461

462

(defmethod repository-insert-field ((repository rdfcache-repository) (solution-field t))

463

(repository-insert-field *transaction* solution-field))

464

465

(defmethod repository-insert-field ((transaction rdfcache-transaction) (solution-field list))

466

(if solution-field

467

(repository-insert-field transaction (repository-intern-statements transaction solution-field))

468

0))

469

470

(defmethod repository-insert-field ((context rdfcache-transaction) (solution-field vector))

471

(loop for field across solution-field

472

sum (repository-insert-field context field)))

473

474

(defmethod repository-insert-field ((transaction rdfcache-transaction) (solution-field array))

475

"Insert the given statements from the repository. If given triples (v/s quads) then add

476

the statements to the static default graph, without allowing for the default/named/all option.

477

When given quads, use ther s-p-o-g order as for sexp-quads."

478

(ecase (array-rank solution-field)

479

#+(or) ;; obsolete. see above

480

(1 (loop for solution-field-page across solution-field

481

sum (repository-insert-field transaction solution-field-page)))

482

(2

483

      (trace-algebra repository-insert-field (repository-id transaction) solution-field (term-value-field solution-field))

484

(assert-argument-type repository-insert-field solution-field

485

                            (or (simple-array fixnum (* 3)) (simple-array fixnum (* 4))))

486

(let ((%transaction (transaction-record transaction))

487

(provenance-p (case *provenance-mode*

488

(|urn:dydra|:|none| nil)

489

(t (when (task-provenance-repository *task*) t)))))

490

(ecase (array-dimension solution-field 1)

491

(3 (do-solution-field (subject predicate object) solution-field

492

                                (rdfcache::insert-statement %transaction rdfcache:*default-context-number*

493

                                                            subject predicate object)))

494

(4 (let ((field-graph 0) (*print-right-margin* 144)

495

(rdf-type-term-id (symbol-term-id '|rdf|:|type|)))

496

;; modify the id list for any graph which appears

497

(do-solution-field (subject predicate object graph) solution-field

498

                                  (when (and (/= subject 0) (/= predicate 0) (/= object 0) (/= graph 0))

499

                                    (when (and provenance-p (/= graph field-graph))

500

(setf field-graph graph)

501

                                      (if (or (not (plusp graph)) (zerop (rdfcache-count %transaction graph 0 0 0)))

502

                                        (setf (transaction-graph-id-created *transaction* graph) t)

503

                                        (setf (transaction-graph-id-modified *transaction* graph) t)))

504

(if (= predicate rdf-type-term-id)

505

                                        (record-new-resource transaction subject)

506

                                        (record-modified-resource transaction subject))

507

#+(or)

508

(format t "~&~a~%"

509

                                            (write-to-string (list (rdfcache-term-number-object %transaction subject)

510

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

511

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

512

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

513

                                    (rdfcache::insert-statement %transaction graph subject predicate object))))))

514

(array-dimension solution-field 0)))))

515

516

;;; matrix operations

517

518

(undefmethod repository-matrix-field ((transaction rdfcache-transaction) context subject predicate object

519

&rest args

520

&key (start 0) end)

521

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

522

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

523

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

524

were variables."

525

526

(declare (dynamic-extent args))

527

(let ((%transaction (transaction-record transaction))

528

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

529

(typecase context

530

((or null integer)

531

(rdfcache:with-cursor (%quad-cursor)

532

(let* ((quad-cursor-count (rdfcache-match %transaction %quad-cursor

533

                                                    context subject predicate object))

534

(%quad-matrix (rdfcache:cursor-to-matrix %transaction %quad-cursor

535

                                                          :row-offset start

536

                                                          :row-limit (when end (- end start)))))

537

            (make-matrix-field :solutions %quad-matrix :data (rdfcache:matrix-data-pointer %quad-matrix)

538

:row-count quad-cursor-count :row-index -1))))

539

(t

540

(flet ((coerce-variable (term &optional (default nil))

541

(if (variable-p term) term default)))

542

;; always provide a context binding to make it available to joins so that patterns

543

;; do not cross graph boundaries

544

(let* ((dimensions (list (coerce-variable context +context-variable+)

545

                                   (coerce-variable subject) (coerce-variable predicate) (coerce-variable object)))

546

(sort-dimensions (remove nil dimensions)))

547

(flet ((coerce-term (term)

548

(if (or (null term) (spocq:blank-node-p term) (variable-p term))

549

wildcard-term ; rdfcache:*wildcard-term-number*

550

(or (rdfcache-lookup-object-term-number term)

551

                           (return-from repository-matrix-field (make-null-matrix sort-dimensions))))))

552

(let* ((matrix-field

553

(apply #'repository-matrix-field transaction

554

                             (coerce-term context) (coerce-term subject) (coerce-term predicate) (coerce-term object)

555

args)))

556

(setf (matrix-field-dimensions matrix-field) dimensions

557

(matrix-field-sort-dimensions matrix-field) sort-dimensions)

558

matrix-field))))))))

559

560

 (undefmethod repository-match-field ((transaction rdfcache-transaction) context subject predicate object &rest args)

561

(let ((field (apply #'repository-matrix-field transaction context subject predicate object args)))

562

(prog1 (term-value-field field)

563

(release-field-data field))))

564

565

(undefmethod repository-matrix-field ((transaction rdfcache-transaction) context subject predicate object

566

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

567

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

568

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

569

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

570

were variables.

571

The result field elements are ordered (c s p o)"

572

573

(let* ((%transaction (transaction-record transaction))

574

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

575

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

576

(dataset (task-dataset-graphs *task*))

577

(effective-contexts

578

           (cond ((null context)       (if dataset (dataset-default-graphs dataset) (list default-context-term)))

579

((variable-p context) (dataset-named-graphs dataset))

580

((typep context 'iri) (list context))

581

(t

582

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

583

context dataset)))))

584

(flet ((coerce-variable (term &optional (default nil))

585

(if (variable-p term) term default)))

586

(rdfcache:with-cursor (%quad-cursor)

587

;;!! the dimension construction should have the effect, that, it retains the

588

;;!! variable in the in the scope of a graph form only

589

;;!! given 'all' graphs, the grap terms should be ignored.

590

;; always provide a context binding to make it available to joins so that patterns

591

;; do not cross graph boundaries

592

(let* ((dimensions (or dimensions

593

                                (list (coerce-variable context nil) ;; +context-variable+)

594

                                      (coerce-variable subject) (coerce-variable predicate) (coerce-variable object))))

595

(sort-dimensions (remove nil dimensions)))

596

(flet ((coerce-term (term)

597

                    (if (or (null term) (and (spocq:blank-node-p term) wild-blank-nodes-p) (variable-p term))

598

wildcard-term

599

(or (rdfcache-lookup-object-term-number term)

600

;; if the term is not in the store, no match is possible

601

                          (return-from repository-matrix-field (make-null-matrix sort-dimensions))))))

602

(let ((interned-subject (coerce-term subject))

603

(interned-predicate (coerce-term predicate))

604

(interned-object (coerce-term object)))

605

(flet ((match-context (interned-effective-context)

606

(let ((count (rdfcache-count %transaction

607

                                                     interned-effective-context

608

                                                     interned-subject interned-predicate interned-object)))

609

(when (plusp count)

610

(rdfcache-match %transaction %quad-cursor

611

interned-effective-context

612

                                            interned-subject interned-predicate interned-object)

613

(rdfcache:cursor-to-matrix %transaction %quad-cursor

614

                                                       :row-offset start

615

                                                       :row-limit (- (or end count) start)))))

616

(count-context (interned-effective-context)

617

(repository-pattern-count transaction

618

                                                  interned-subject interned-predicate interned-object

619

                                                  interned-effective-context)))

620

;; manage the count separately rather than using the matrix sizes to allow

621

;; for eventual streaming

622

;; (print (cons :effective-contexts effective-contexts))

623

(let* ((interned-effective-contexts (loop for context in effective-contexts

624

                                                           for interned-context = (case context

625

                                                                                    (|urn:dydra|:|all| rdfcache:*all-context-number*)

626

                                                                                    (|urn:dydra|:|default| rdfcache:*default-context-number*)

627

                                                                                    (|urn:dydra|:|named| rdfcache:*named-context-number*)

628

                                                                                    (t (rdfcache-lookup-object-term-number context)))

629

                                                           ;; if it is not known, there can be no result

630

                                                           when interned-context

631

                                                           collect interned-context))

632

(%accumulated-matrix nil))

633

;; (print (cons :interned-effective-contexts interned-effective-contexts))

634

(loop for interned-context in interned-effective-contexts

635

for %matrix = (match-context interned-context)

636

do (when %matrix

637

(cond (%accumulated-matrix

638

                                     (setf %accumulated-matrix (rdfcache::matrix-concatenate %accumulated-matrix %matrix))

639

(rdfcache:matrix-release %matrix))

640

(t

641

(setf %accumulated-matrix %matrix)))))

642

(if %accumulated-matrix

643

(make-matrix-field :solutions %accumulated-matrix

644

                                           :row-count (rdfcache:matrix-row-count %accumulated-matrix)

645

:row-index 0

646

:dimensions dimensions

647

:sort-dimensions sort-dimensions

648

                                           :count (rdfcache:matrix-row-count %accumulated-matrix))

649

(make-matrix-field :row-count 0 :row-index 0

650

:dimensions dimensions

651

:sort-dimensions sort-dimensions

652

:count 0)))))))))))

653

654

 (undefmethod repository-match-matrix ((transaction rdfcache-transaction) matrix context subject predicate object

655

&key (start 0) end)

656

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

657

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

658

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

659

were variables."

660

661

(let* ((%transaction (transaction-record transaction))

662

(contexts (if (consp context) context (list context)))

663

(result-matrix (if (and matrix (not (cffi:null-pointer-p matrix)))

664

matrix

665

(rdfcache:make-matrix 0 4)))

666

(result-count 0)

667

(offset start)

668

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

669

(rdfcache:with-cursor (%quad-cursor)

670

(flet ((match-context (context)

671

                (when (plusp (rdfcache-match %transaction %quad-cursor context subject predicate object))

672

                  ;; accept a possibly replace matrix and track the count of matched solutions including those skipped

673

(multiple-value-bind (new-matrix count)

674

                                       (rdfcache:cursor-append-matrix %transaction %quad-cursor result-matrix

675

                                                                      :row-offset offset :row-limit limit)

676

(setf result-matrix new-matrix)

677

(incf result-count count)

678

(when (and limit (> count offset)) (decf limit (- count offset)))

679

(setf offset (max 0 (- offset count)))))))

680

(loop for context in contexts

681

until (and limit (<= limit 0))

682

do (match-context context))

683

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

684

685

 ;;; (trace repository-match-matrix rdfcache:make-matrix rdfcache:match rdfcache:cursor-append-matrix  rdfcache::matrix-nconc  rdfcache:matrix-free)

686

687