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

Kind	Covered	All	%
expression	8	729	1.1
branch	0	48	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

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

2

3

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

4

5

(:documentation "SPOCQ rdfhdt extension"

6

"Specialize repository, revision and transaction classes

7

to refer to spocq wrappers for rdfhdt entities.

8

9

* classes

10

- hdt-repository : binds a reference to an hdt external record.

11

Open map the hdt context upon first use and close it when finalizing.

12

Treat the refernce as an opaque object - this is without access to its fields.

13

- hdt-revision : specialized in order to use an hdt-transaction.

14

- hdt-transaction : to conform to the standard access, but with no relation to

15

the state of the hdt map

16

- hdt-dictionary

17

- hdt-triples

18

- hdt-header

19

20

* processing

21

The hdt map remains until the repository is terminated.

22

The hdt document components - header, dictionary triples, are treated as

23

opaque entities, just as the mapped context itself.

24

All operations are through operators

25

- lmdb doc follows -

26

The lmdb practice is that an environment remain open for a process' duration.

27

On the other hand, each must be closed in order to release lmdb resources,

28

which are otherwise eventually exhausted. This occurs in terms of either

29

environments or databases at a relatively low limit.

30

The practice is also that a database be opened on the first occasion and then

31

remain open until the environment is closed. In order to effect this, the

32

respective transaction must be committed - even when it is read-only, while

33

the database remain open, after which the database is re-used in other

34

transactions.

35

The practice with transactions is that they are created on-demand and must be

36

closed in order to release cursors - whereby cursors in a read-only

37

transaction must be closed explicitly.

38

39

This leads to the following pattern:

40

task

41

-> spocq:hdt-repository

42

-> rlmdb:repository : finalize closes environment

43

-> lmdb:environment : finalize closes lmdb entity iff still open

44

-> spocq:lmdb-revision

45

-> spocq:hdt-repository

46

-> rlmdb:repository : cloned from its referent repository

47

-> spocq:hdt-transaction : destroy transaction closes

48

-> lmdb:transaction

49

50

This leads to two different processing patterns

51

- with-open-

52

- ensure-open-

53

54

the former arranges for the lmdb entity to have dynamic extent: the entity is

55

created/opened, as needed, upon entry and closed/destroyed upon exit iff it

56

was created/opened

57

the latter arranges for the entity to have indefinite extent: the entity is

58

created/opened, as needed, upon entry, but left intact upon exit.

59

60

this is reflected in individual operations as follows:

61

- autonomous operations use with-open-transaction.

62

this creates and manages a dynamic transaction for the cases where it should

63

be closed. eg. when opening the repository, the transaction must be closed in

64

order to afford the repository databases indefinite extent.

65

- retrieval operation use ensure-open-transaction with the single

66

lmdb:transaction bound into the spocq transaction.

67

this creates an lmdb entity with indefinite extent which is reused for all

68

get/put/cursor operations to cause all to use the same lmdb state.

69

70

access operations must support to modes:

71

- in the context of an hdt-repository, establish a dynamic transaction

72

wrt the lmdb environment for the databases to reuse. commit it at the

73

conclusion in order to leave them intact.

74

- in the context of an hdt-transaction, use its lmdb entity directly

75

for databases and leave it unchanged at the conclusion.

76

77

#+/-hdt-autonomous-transactions

78

if present supporess rdfcache transaction menagement for hdt

79

")

80

81

82

;;; for testing only

83

;;;(setq *class.repository* 'hdt-repository)

84

85

(defclass hdt-repository (lmdb-repository)

86

((hdt-environment

87

:initform nil

88

:reader get-repository-hdt-environment :writer setf-repository-hdt-environment

89

:documentation "binds a handle on an external hdt environment")

90

(transaction-class

91

:initform 'hdt-transaction :allocation :class)

92

(revision-class

93

:allocation :class

94

:initform 'hdt-repository-revision)

95

(storage-class

96

:initform 'hdt-document :allocation :class)

97

(term-count

98

:accessor repository-term-count)

99

(spocq->store-term-registry

100

:reader repository-spocq->store-term-registry

101

:initform (make-registry :test #'equal)

102

:documentation "Maps native objects to their store identifiers in the context of the

103

query / repository. Terms cache the identifier internally.

104

It starts as a copy of the global registry and accumulates terms.")

105

(store->spocq-term-registry

106

:initform (make-registry :test #'equal)))

107

(:documentation "An HDT environment serves as a handle on a mapped rdfhdt file.

108

its constituents - header, dictionary, triples are made available via ffi

109

accessors only."))

110

111

(defclass hdt-repository-revision (hdt-repository lmdb-revision)

112

()

113

(:documentation "Specialize the lmdb-revision for hdt datasets

114

This includes the temporal attributes in case they become relevant."))

115

116

(defclass hdt-document (rlmdb:repository) ;; (repository-storage)

117

;; use an lmdb database to map hdt term numbers to dydra term ordinals

118

;;!!! needs a different superclass in order to specify alternative databases

119

((rlmdb.i::transaction-class

120

:initform 'rlmdb:rdfcache-quad-transaction :allocation :class)))

121

122

(defgeneric repository-next-id (repository)

123

(:method ((repository hdt-repository))

124

;; not threadsafe !!!

125

;; use the graph role as it is unknown where it belongs

126

(hdt-box-term-number (incf (repository-term-count repository)) :graph)))

127

128

(defclass hdt-transaction (lmdb-transaction)

129

())

130

131

(defmethod validate-storage-class ((repository hdt-repository) (storage hdt-document))

132

t)

133

134

(defgeneric (setf repository-hdt-environment) (%handle repository)

135

(:method (%handle (repository hdt-repository))

136

(let ((%old-handle (get-repository-hdt-environment repository)))

137

(when (and %old-handle (not (cffi:null-pointer-p %old-handle)))

138

(hdt:%delete-hdt %old-handle)

139

(sb-ext:cancel-finalization repository))

140

(when (and %handle (not (cffi:null-pointer-p %handle)))

141

(sb-ext:finalize repository

142

#'(lambda () (hdt:%delete-hdt %handle)))))

143

(setf-repository-hdt-environment %handle repository)))

144

145

(defgeneric repository-hdt-environment (repository)

146

(:method ((repository hdt-repository))

147

(or (get-repository-hdt-environment repository)

148

(let* ((file-pathname (repository-hdt-pathname repository)))

149

(unless (probe-file file-pathname)

150

(spocq.e:resource-not-found-error :resource (repository-uri repository)))

151

(let ((%handle (hdt:map-indexed-hdt file-pathname)))

152

(assert (and %handle (not (cffi:null-pointer-p %handle))) ()

153

"hdt open failed: ~s" (repository-pathname repository))

154

(setf (repository-term-count repository)

155

(+ (hdt::%hdt-get-n-subjects %handle)

156

(hdt::%hdt-get-n-properties %handle)

157

(hdt::%hdt-get-n-objects %handle)))

158

(setf (repository-hdt-environment repository) %handle)))))

159

(:method ((transaction hdt-transaction))

160

(repository-hdt-environment (transaction-repository transaction))))

161

162

(defparameter *hdt-filename* (make-pathname :name "dataset" :type "hdt"))

163

164

(defgeneric repository-hdt-pathname (repository)

165

(:method ((root pathname))

166

(merge-pathnames *hdt-filename* root))

167

(:method ((repository repository))

168

(repository-hdt-pathname (repository-catalog-pathname repository)))

169

(:method ((repository-id string))

170

(repository-hdt-pathname (repository-catalog-pathname repository-id))))

171

172

(defgeneric repository-is-hdt (designator)

173

(:method ((repository hdt-repository))

174

t)

175

(:method ((object t))

176

nil)

177

(:method ((repository-id string))

178

(let ((id-type (repository-id-type repository-id)))

179

(if (and id-type (subtypep id-type *class.hdt-repository*))

180

t

181

(repository-is-hdt (repository-pathname repository-id)))))

182

(:method ((location pathname))

183

(probe-file (repository-hdt-pathname location))))

184

185

(pushnew (list *class.hdt-repository* (cl-ppcre:create-scanner "[^/]+/.+__hdt"))

186

*repository-id-type-map*

187

:key #'first)

188

189

190

;!!! should be date-time

191

(defmethod repository-write-date ((repository hdt-repository))

192

"return the universal time for the last file modification"

193

(let ((pathname (repository-hdt-pathname repository)))

194

(when (probe-file pathname)

195

(let ((timestamp (file-write-date pathname)))

196

(universal-time-date-time timestamp)))))

197

198

(defmethod repository-revision-write-date ((repository hdt-repository) (revision-id string))

199

(repository-write-date repository))

200

201

(defmethod repository-write-timestamp ((repository hdt-repository))

202

"return the universal time for the last write"

203

(rlmdb:get-metadata-timestamp repository))

204

205

(defmethod initialize-repository-storage ((repository-id string) (prototype hdt-repository) &key)

206

(call-next-method)

207

(with-open-file (stream (repository-hdt-pathname repository-id)

208

:if-does-not-exist :create

209

:if-exists :append)

210

repository-id))

211

212

;;; hdt transactions perform just the lmdb aspects

213

214

#+hdt-autonomous-transactions

215

(defmethod transaction-open ((transaction hdt-transaction) &key (if-does-not-exist :error))

216

(declare (ignore if-does-not-exist))

217

(when-transaction-record (%record transaction :error-p transaction-open)

218

(case (rdfcache::transaction-status %record)

219

((:initialized :uninitialized)

220

;; (rdfcache:print-transaction %record)

221

;; (rdfcache:begin-transaction %record)

222

(setf (rdfcache::transaction-status %record) :begun)

223

(trace-transaction 'transaction-open %record)

224

;; generate the uri proactively

225

(transaction-uri transaction)

226

(revision-uri transaction)

227

(log-debug "transaction-open: transaction: ~a" transaction)

228

transaction)

229

((:begun :begin :mutated) t)

230

(t

231

;; in any other state attempt to cancel the thread. this is observed when a compilation

232

;; step fails for one node, 'simultaneously' with others just starting out

233

;; if that returns, which means there is nothing prepared for this, signal an error

234

(log-warn "transaction-open: open a completed transaction: ~a" transaction)

235

(cancel-thread (bt:current-thread))

236

(error "transaction-open: no cancel-thread handler")))))

237

238

#+hdt-autonomous-transactions

239

(defmethod transaction-close ((transaction hdt-transaction) (disposition (eql :abort)))

240

(when-transaction-record (%record transaction)

241

(block :abort-transaction

242

;; try to handle these more delicately if the transaction is being closed

243

;; than in the standard exit-on-error case

244

(setf (rdfcache:transaction-status %record) :aborted))

245

;; no end time if aborted

246

;; !! no copy out any useful data and destroy it

247

;; !! make sure it is locked

248

(trace-transaction 'repository-close-transaction.abort %record)

249

(transaction-get-record-state transaction)))

250

#+hdt-autonomous-transactions

251

 (defmethod transaction-close ((transaction hdt-transaction) (disposition (eql :commit))) ;;;  (break "committing")

252

(when-transaction-record (%record transaction)

253

(case (rdfcache:transaction-status %record)

254

((:begun :mutated)

255

(setf (rdfcache:transaction-status %record) :committed)

256

(transaction-write-event transaction)))

257

(setf (transaction-end-time transaction) (get-universal-time))

258

(transaction-get-record-state transaction)

259

(trace-transaction 'transaction-close %record)))

260

#+hdt-autonomous-transactions

261

(defmethod transaction-close ((transaction hdt-transaction) (disposition (eql :abort)))

262

(let ((lmdb:transaction (bound-slot-value transaction 'lmdb-transaction)))

263

(when (lmdb:open-p lmdb:transaction)

264

(lmdb:abort-transaction lmdb:transaction))

265

(setf-transaction-lmdb-transaction nil transaction)))

266

#+hdt-autonomous-transactions

267

(defmethod transaction-close ((transaction hdt-transaction) (disposition (eql :commit)))

268

(let ((lmdb:transaction (bound-slot-value transaction 'lmdb-transaction)))

269

(when (lmdb:open-p lmdb:transaction)

270

(lmdb:commit-transaction lmdb:transaction))

271

(setf-transaction-lmdb-transaction nil transaction)))

272

273

;;!! bad name

274

(defmethod repository-wildcard-term ((repository hdt-repository))

275

0)

276

277

(defmethod repository-wildcard-term-number ((repository hdt-repository))

278

0)

279

280

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

281

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

282

283

284

(defmethod repository-write-date ((revision hdt-repository-revision))

285

"return the universal time for the revision end timestamp"

286

(repository-write-date (repository-revision-reference revision)))

287

288

(defmethod repository-revision-write-date ((repository hdt-repository-revision) (revision-id string))

289

(repository-write-date (repository-revision-reference repository)))

290

291

(defmethod repository-revision-write-timestamp ((repository hdt-repository-revision) (revision-id string))

292

;; there is just one

293

(repository-write-timestamp (repository-revision-reference repository)))

294

295

296

(defmethod transaction-write-event ((transaction hdt-transaction))

297

;; no write transactions are implemented

298

nil)

299

300

(defmethod repository-list-revision-ids ((repository hdt-repository))

301

nil)

302

303

(defmethod revisioned-repository-p ((repository hdt-repository))

304

nil)

305

306

(defmethod rlmdb:put-repository-metadata progn ((repository hdt-repository) &rest args)

307

;; uses it's associated lmdb repository to manage metadata

308

(apply #'rlmdb:put-repository-metadata (repository-lmdb-repository repository) args))

309

310

(defmethod repository-revision-bounds ((repository hdt-repository))

311

nil)

312

313

314

(defgeneric transaction-hdt-environment (transaction)

315

(:method ((transaction hdt-transaction))

316

(let* ((revision (transaction-revision transaction)))

317

(repository-hdt-environment revision))))

318

319

(defgeneric hdt-object-term-literal (object)

320

(:method ((object null))

321

"")

322

(:method ((object symbol))

323

(assert (iri-p object))

324

(iri-lexical-form object))

325

(:method ((object spocq:iri))

326

(iri-lexical-form object))

327

(:method ((object t))

328

(let ((*expand-literal-values* t))

329

(with-output-to-string (stream) (encode-turtle-object object stream)))))

330

331

;; the cache can work in just the number->object direction as the number is

332

;; specific to role.

333

;; for hdt, the cache should be repository-relative as there are not revisions

334

(defgeneric hdt-object-term-number (repository object role)

335

(:documentation "lookup the role-specific term indentifier in the

336

hdt environment dictionary. a null argument yields zero, which is a wildcard.

337

if the term is not present, return nil")

338

(:method ((repository hdt-repository) object role)

339

(if object

340

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

341

(%dictionary (hdt:%hdt-get-dictionary %environment))

342

(term-literal (hdt-object-term-literal object)))

343

(hdt:%term-literal-term-number %dictionary term-literal role))

344

0))

345

(:method ((transaction hdt-transaction) object role)

346

(hdt-object-term-number (transaction-repository transaction) object role)))

347

348

(defparameter *hdt-object-cache-mode* t)

349

350

(defgeneric hdt-term-number-object (repository term-number)

351

(:method ((repository hdt-repository) term-number)

352

(flet ((cache-object (object)

353

(when *hdt-object-cache-mode*

354

(setcache object (repository-spocq->store-term-registry repository) term-number)

355

(setcache term-number (repository-store->spocq-term-registry repository) object))

356

object))

357

(if (= term-number 0)

358

(load-time-value (spocq:make-unbound-variable "0"))

359

(or (and *hdt-object-cache-mode*

360

                    (get-registry term-number (repository-store->spocq-term-registry repository)))

361

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

362

(%dictionary (hdt:%hdt-get-dictionary %environment))

363

(literal (hdt:%term-number-term-literal %dictionary term-number))

364

(object

365

(if (plusp (length literal))

366

(case (char literal 0)

367

(#\" (parse-term literal))

368

(#\_ (intern-blank-node (subseq literal 2)))

369

(t (intern-iri literal)))

370

(spocq:make-unbound-variable (princ-to-string term-number)))))

371

(cache-object object))))))

372

(:method ((transaction hdt-transaction) term-number)

373

(hdt-term-number-object (transaction-repository transaction) term-number)))

374

375

(defmethod repository-term-number-object ((repository hdt-repository) term-number)

376

(hdt-term-number-object repository term-number))

377

(defmethod repository-term-number-object ((transaction hdt-transaction) term-number)

378

(repository-term-number-object (transaction-repository transaction) term-number))

379

380

(defmethod repository-object-term-number ((repository hdt-repository) object)

381

"Lookup the term identifier with the assumption that a query against an

382

hdt repository will abstract over the subject and object terms only and for that,

383

the shared subject id is sufficient.

384

if the terms is not found, make an ephemeral id and cache it

385

test cache first and cache always if the object is not in the dataset"

386

(or (get-registry object (repository-spocq->store-term-registry repository))

387

(hdt-object-term-number repository object :subject)

388

(let ((term-number (repository-next-id repository)))

389

(setf (get-registry object (repository-spocq->store-term-registry repository)) term-number)

390

(setf (get-registry term-number (repository-store->spocq-term-registry repository)) object)

391

term-number)))

392

393

(defmethod repository-object-term-number ((transaction hdt-transaction) object)

394

(repository-object-term-number (transaction-repository transaction) object))

395

396

397

(defgeneric hdt-intern-property-path (context property-path)

398

   (:documentation "Intern a property path in a given transaction context. Descend to each verb in the path,

399

intern its term and cache the respective term number.")

400

401

(:method (context (path unary-property-path))

402

(hdt-intern-property-path context (unary-property-path-element path))

403

path)

404

405

(:method (context (path nary-property-path))

406

(dolist (element (nary-property-path-elements path))

407

(hdt-intern-property-path context element))

408

path)

409

410

(:method (context (path property-path-verb))

411

(or (property-path-verb-value path)

412

(setf (property-path-verb-value path)

413

(hdt-object-term-number context (property-path-verb-iri path) :predicate)))))

414

415

(defgeneric hdt-extern-field (solution-data)

416

(:documentation "Transform a term-number matrix/array into the object-solution field,

417

that is a list of solutions, based on the active hdt dictionary")

418

(:method ((solution-data array))

419

(let* ((field-length (array-dimension solution-data 0))

420

(field-width (array-dimension solution-data 1)))

421

(flet ((field-term-number-object (term-number)

422

(repository-term-number-object *repository* term-number)))

423

(loop for solution-index from 0 below field-length

424

collect (loop for term-index from 0 below field-width

425

                     collect (field-term-number-object (aref solution-data solution-index term-index)))))))

426

(:method ((term-number integer))

427

(repository-term-number-object *repository* term-number))

428

(:method ((datum t)) datum)

429

430

#+sbcl

431

(:method ((matrix sb-sys:system-area-pointer))

432

(let ((numeric-field (rdfcache:matrix-to-list matrix)))

433

(hdt-extern-field (make-array (list (length numeric-field) (length (first numeric-field)))

434

:initial-contents numeric-field))))

435

436

(:method ((datum matrix-field))

437

(let ((solutions (solution-field-solutions datum)))

438

(unless (cffi:null-pointer-p solutions)

439

(let ((numeric-field (subseq (rdfcache:matrix-to-list solutions)

440

0 (solution-field-row-count datum))))

441

(hdt-extern-field (make-array (list (length numeric-field) (length (first numeric-field)))

442

                                              :initial-contents numeric-field))))))

443

444

(:method ((generator solution-generator))

445

(let ((channel (abstract-field-generator-channel generator))

446

(dimensions (abstract-field-generator-dimensions generator))

447

(results ()))

448

(do-pages (page channel)

449

(push (term-value-field page) results))

450

(values (reduce #'nconc (nreverse results) :from-end t)

451

dimensions))))

452

453

(defun test-sparql-hdt (query-string &rest args)

454

(apply #'test-sparql query-string

455

:solution-handler #'hdt-extern-field

456

args))

457

458

;;; support for single-transaction describes

459

460

(defmethod process-describe ((subject-source hdt-transaction) (object-source hdt-transaction)

461

(destination array-page-channel)

462

(base-source array-page-channel)

463

base-dimensions subjects)

464

(let* ((repository (transaction-repository subject-source)))

465

(spocq.i::process-describe repository repository

466

destination base-source

467

base-dimensions subjects)))

468

469

(defmethod process-describe ((subject-source hdt-repository) (object-source hdt-repository)

470

(destination array-page-channel)

471

(base-source array-page-channel)

472

base-dimensions subjects)

473

474

(let* ((repository (transaction-repository subject-source)))

475

(spocq.i::process-describe repository repository

476

destination base-source

477

base-dimensions subjects)))

478

479

480

481

482

483

;;; kleen star path support

484

485

 (defmethod map-repository-subject-and-objects ((continuation function) (transaction hdt-transaction) context &rest args)

486

(declare (ignore args)) ;; distinct is ignored

487

;; the path processsing does it anyway to merge subjects and object

488

;; function (context termid)

489

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

490

(flet ((hdt-continuation (subject predicate object)

491

(declare (ignore predicate))

492

(funcall continuation default-graph-term-number subject)

493

(funcall continuation default-graph-term-number object)))

494

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

495

(let ((quad-pattern (vector context 0 0 0)))

496

(hdt:%map-repository-statements #'hdt-continuation (repository-hdt-environment transaction)

497

quad-pattern)))))

498

499

 (defmethod repository-query-by-verb ((continuation t) (transaction hdt-transaction) context subject (predicate spocq:iri) object)

500

"if the predicate is an iri, use it as a term identifier."

501

(let ((id (hdt-object-term-number transaction predicate :predicate)))

502

(if id

503

(repository-query-by-verb continuation transaction context subject id object)

504

0)))

505

506

 (defmethod repository-query-by-verb ((continuation t) (transaction hdt-transaction) context subject (predicate symbol) object)

507

"Iff a given symbol designates a term, then use the term's number as the predicate."

508

(let ((id (hdt-object-term-number transaction predicate :predicate)))

509

(when id

510

(repository-query-by-verb continuation transaction context subject id object))))

511

512

 (defmethod repository-query-by-verb ((continuation t) (transaction hdt-transaction) context subject (predicate integer) object)

513

"if the predicate is an integer, it as a term number - perform the actual match and upon success

514

invoke the continuation with the concrete terms under cycle constraints"

515

(cond ((null (transaction-parent-p transaction))

516

(trace-paths "pp.rqbv.suppress : query-by-verb for empty repository: ~a" transaction)

517

nil)

518

(t

519

(trace-paths "pp.rqbv.hdt : ~a(~a) ~a(~a) ~a(~a)~%"

520

(format-term-number-object subject) subject

521

(format-term-number-object predicate) predicate

522

(format-term-number-object object) object)

523

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

524

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

525

(call-path-continuation continuation

526

                                             (or *match-target-graph* context default-graph-term-number)

527

s p o)

528

t))

529

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

530

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

531

                                             subject predicate object))))))

532

533

 (defmethod repository-count-by-verb ((transaction hdt-transaction) context subject (predicate spocq:iri) object)

534

"if the predicate is an iri, use it as a term identifier."

535

(let ((id (hdt-object-term-number transaction predicate :predicate)))

536

(if id

537

(repository-count-by-verb transaction context subject id object)

538

0)))

539

540

(defmethod repository-count-by-verb ((transaction hdt-transaction) context subject (predicate symbol) object)

541

   "Iff a given symbol designates a term, then use the term's number as the predicate. Otherwise return zero."

542

(let ((id (hdt-object-term-number transaction predicate :predicate)))

543

(if id

544

(repository-count-by-verb transaction context subject id object)

545

0)))

546

547

(defmethod repository-count-by-verb ((transaction hdt-transaction) context subject (predicate integer) object)

548

   "Iff a given symbol designates a term, then use the term's number as the predicate. Otherwise return zero."

549

(hdt:%hdt-read-id-pattern-count (repository-hdt-environment transaction)

550

subject predicate object))

551

552

553

554

555

(defmethod repository-pattern-count ((repository hdt-repository) subject predicate object context)

556

(let ((wildcard-term "")) ;; (repository-wildcard-term repository)))

557

(flet ((hdt-term (term)

558

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

559

wildcard-term

560

(hdt-object-term-literal term))))

561

(if (extension-operator-p predicate)

562

1

563

(let ((hdt-subject (hdt-term subject))

564

(hdt-predicate (hdt-term predicate))

565

(hdt-object (hdt-term object)))

566

(if (and (eql hdt-subject "") (eql hdt-predicate "") (eql hdt-object ""))

567

;; context does not matter in this relation

568

                 ;; can delegate to a method which reads the count directly from the repo statistics record

569

(repository-statement-count repository)

570

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

571

(pattern (list subject predicate object context)))

572

(declare (dynamic-extent pattern))

573

;; always read-only

574

(or (gethash pattern stats)

575

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

576

                             (hdt::%hdt-read-term-pattern-count (repository-hdt-environment repository)

577

                                                                hdt-subject hdt-predicate hdt-object))))))))))

578

579

(defmethod read-repository-statement-count ((repository hdt-repository))

580

(hdt:%hdt-statement-count (repository-hdt-environment repository)))

581

582

(defmethod read-repository-statement-count ((transaction hdt-transaction))

583

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

584

585

586

587

;;; mapping

588

589

(defmethod map-repository-contexts (function (transaction hdt-transaction) &rest args)

590

(declare (dynamic-extent args))

591

(apply #'map-repository-contexts function (transaction-repository transaction) args))

592

593

(defmethod map-repository-contexts (function (repository hdt-repository) &key distinct default)

594

"An hdt-repository comprises just one context, named as the instance identifier"

595

(declare (ignore distinct default))

596

;;;!!! claim the graph identifier is an object term

597

(funcall function (hdt-object-term-number repository (instance-identifier repository) :object)))

598

599

600

(defmethod map-repository-objects (function (transaction hdt-transaction) &rest args)

601

(declare (dynamic-extent args))

602

(apply #'map-repository-objects function (transaction-repository transaction) args))

603

604

(defmethod map-repository-objects (function (repository hdt-transaction) &key

605

context (distinct t))

606

(declare (dynamic-extent function))

607

(declare (ignore context))

608

(hdt::%map-object-numbers function (repository-hdt-environment repository)

609

:distinct distinct))

610

611

(defmethod map-repository-predicates (function (transaction hdt-transaction) &rest args)

612

(declare (dynamic-extent args))

613

(apply #'map-repository-predicates function (transaction-repository transaction) args))

614

615

(defmethod map-repository-predicates (function (repository hdt-repository) &key

616

context (distinct t))

617

(declare (dynamic-extent function))

618

(declare (ignore context))

619

(hdt::%map-predicate-numbers function (repository-hdt-environment repository)

620

:distinct distinct))

621

622

(defmethod map-repository-subjects (function (transaction hdt-transaction) &rest args)

623

(declare (dynamic-extent args))

624

(apply #'map-repository-subjects function (transaction-repository transaction) args))

625

626

(defmethod map-repository-subjects (function (repository hdt-repository) &key

627

context (distinct t))

628

(declare (dynamic-extent function))

629

(declare (ignore context))

630

(hdt::%map-subject-numbers function (repository-hdt-environment repository)

631

:distinct distinct))

632

633

634

;;; term-level matching

635

636

(defmethod repository-match-field ((transaction hdt-transaction) context subject predicate object &rest args)

637

(declare (dynamic-extent args))

638

(apply #'repository-match-field (transaction-revision transaction) context subject predicate object args))

639

640

 (defmethod repository-match-field ((revision hdt-repository-revision) context subject predicate object &rest args)

641

(declare (dynamic-extent args))

642

   (apply #'repository-match-field (repository-revision-reference revision) context subject predicate object args))

643

644

(defmethod repository-match-field ((repository hdt-repository) context subject predicate object

645

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

646

(first nil) (last nil))

647

"Generate a solution term sequence for the statements which match the argument term pattern.

648

Intern all terms. Should some term not be present, then return null.

649

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

650

were variables.

651

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

652

For a single-file hdt repository, the graph is always the repository instance identifer.

653

654

The variant for hdt requires no transaction, as they are read-only."

655

(unless first (setf first (repository-last-revision repository)))

656

(unless last (setf last first))

657

(let* ((wildcard-term "") ;; (repository-wildcard-term repository))

658

(result ())

659

(count 0)

660

(sort-dimensions ())

661

(identifier (instance-identifier repository)))

662

(when context

663

(unless (equalp context identifier)

664

(log-warn "repository-match-field: context is ignored: ~s" context)))

665

(labels ((when-variable (term)

666

(when (variable-p term) term))

667

(hdt-term (term)

668

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

669

wildcard-term

670

(hdt-object-term-literal term)))

671

(spocq-term (hdt-term)

672

(parse-term hdt-term))

673

(collect-spo (subject predicate object)

674

;; returns quads although for the triple-htriple case the context

675

;; always indicates the default graph

676

(when (> (incf count) start)

677

(when (and end (> count end))

678

(complete))

679

(push (list identifier

680

(spocq-term subject)

681

(spocq-term predicate)

682

(spocq-term object))

683

result)))

684

(complete ()

685

                (return-from repository-match-field (values (nreverse result) sort-dimensions first last))))

686

(declare (dynamic-extent #'collect-spo))

687

(setf sort-dimensions (remove nil (or dimensions

688

                                             (list (when-variable context)

689

                                                   (when-variable subject)

690

                                                   (when-variable predicate)

691

                                                   (when-variable object)))))

692

(let ((hdt-subject (hdt-term subject))

693

(hdt-predicate (hdt-term predicate))

694

(hdt-object (hdt-term object)))

695

(hdt:%hdt-map-triple-strings* #'collect-spo (repository-hdt-environment repository)

696

hdt-subject

697

hdt-predicate

698

hdt-object))

699

(complete))))

700

701

#+(or)

702

(

703

(in-package :spocq.i)

704

(initialize-spocq)

705

(cffi:load-foreign-library #p"/opt/spocq/libhdt_lisp.so")

706

(load "patches/rdfhdt.lisp")

707

(load "patches/spocq-classes.lisp")

708

(load "patches/bgp-streaming.lisp")

709

710

  (defparameter *allie-repo* (make-instance 'hdt-repository :id "hdtaccount/hdttest" :hdt-filename "allie_pubmed.hdt"))

711

(setf (repository "hdtaccount/hdttest") *allie-repo*)

712

(repository "hdtaccount/hdttest")

713

714

(trace hdt:%map-repository-statements* :break t hdt-continue-map compute-bgp-lambda)

715

(test-sparql "select count(*) where {?s ?p ?o}"

716

:repository-id "hdtaccount/hdttest")

717

;;; ((57153765))

718

(test-sparql "select (count(distinct ?p) as ?count) where {?s ?p ?o}"

719

:repository-id "hdtaccount/hdttest")

720

;;; ((23))

721

722

(test-sparql "select ?p (count (?p) as ?count)where {?s ?p ?o} group by ?p"

723

:repository-id "hdtaccount/hdttest")

724

#+(or)

725

((<http://example.org/subject20180323:398208461> 32275176)

726

(<http://example.org/subject20180323:407727994> 12439253)

727

(<http://example.org/object20180323:421498937> 10)

728

(<http://example.org/subject20180323:425791387> 18)

729

(<http://example.org/object20180323:425791387> 11) ("20180323:425791387" 4)

730

("20180323:421498937" 1) (<http://example.org/subject20180323:417175412> 3)

731

(<http://example.org/subject20180323:412499307> 24) ("20180323:412499307" 9)

732

(<http://example.org/object20180323:417175412> 18) ("20180323:407727994" 9)

733

(<http://example.org/object20180323:412499307> 9)

734

(<http://example.org/subject20180323:421498937> 2)

735

(<http://example.org/object20180323:398208461> 7647157)

736

(|http://www.w3.org/1999/02/22-rdf-syntax-ns#|:|type| 4792051)

737

("20180323:398208461" 3) (<http://example.org/subject20180323:402990116> 1)

738

(<http://example.org/object20180323:402990116> 1) ("20180323:402990116" 1)

739

(<http://example.org/object20180323:407727994> 2) ("20180323:417175412" 1)

740

(<http://example.org/subject20180323:430204034> 1))

741

742

(trace hdt::%id-cursor-next :break t)

743

744

(trace ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::OBJECT-TERM-NUMBER :break t

745

ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::RDFCACHE-FIND-OBJECT-TERM-NUMBER :break t

746

ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::RDFCACHE-LOOKUP-OBJECT-TERM-NUMBER :break t

747

ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::RDFCACHE-LOOKUP-OBJECT-TERM-NUMBER! :break t

748

ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::RDFCACHE-OBJECT-TERM-NUMBER :break t

749

ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::REPOSITORY-OBJECT-TERM-NUMBER :break t

750

)

751

;;; (defparameter *repo-name* "hdtaccount/hdttest")

752

;;; (repository-match-field *repo-name* nil nil nil nil)

753

;;; (time (dotimes (x 100) (repository-match-field *repo-name* nil nil nil nil))

754

755

756

)